X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/166f1209c39e32006f326cf4b701052474addea9..f0af002c737e9413e85d737a29c8c9b396c13414:/perly.y

diff --git a/perly.y b/perly.y
index bf51922..91a7613 100644
--- a/perly.y
+++ b/perly.y
@@ -1,7 +1,7 @@
 /*    perly.y
  *
  *    Copyright (c) 1991-2002, 2003, 2004, 2005, 2006 Larry Wall
- *    Copyright (c) 2007, 2008 by Larry Wall and others
+ *    Copyright (c) 2007, 2008, 2009, 2010, 2011 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -69,12 +69,12 @@
 #endif
 }
 
-%token <ival> GRAMPROG GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ
+%token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ
 
-%token <i_tkval> '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';'
+%token <i_tkval> '{' '}' '[' ']' '-' '+' '$' '@' '%' '*' '&' ';' '=' '.'
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST
-%token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
+%token <opval> FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB
 %token <opval> PLUGEXPR PLUGSTMT
 %token <p_tkval> LABEL
 %token <i_tkval> FORMAT SUB ANONSUB PACKAGE USE
@@ -84,24 +84,22 @@
 %token <i_tkval> FUNC0 FUNC1 FUNC UNIOP LSTOP
 %token <i_tkval> RELOP EQOP MULOP ADDOP
 %token <i_tkval> DOLSHARP DO HASHBRACK NOAMP
-%token <i_tkval> LOCAL MY MYSUB REQUIRE
-%token <i_tkval> COLONATTR
-
-%type <i_tkval> lpar_or_qw
+%token <i_tkval> LOCAL MY REQUIRE
+%token <i_tkval> COLONATTR FORMLBRACK FORMRBRACK
 
 %type <ival> grammar remember mremember
 %type <ival>  startsub startanonsub startformsub
 /* FIXME for MAD - are these two ival? */
-%type <ival> mydefsv mintro
+%type <ival> mintro
 
-%type <opval> stmtseq fullstmt barestmt block mblock else
+%type <opval> stmtseq fullstmt labfullstmt barestmt block mblock else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
-%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr miexpr
-%type <opval> listexpr listexprcom indirob listop method
-%type <opval> formname subname proto subbody cont my_scalar
+%type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
+%type <opval> optlistexpr optexpr indirob listop method
+%type <opval> formname subname proto subbody cont my_scalar formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> termbinop termunop anonymous termdo
-%type <p_tkval> label
+%type <opval> formstmtseq formline formarg
 
 %nonassoc <i_tkval> PREC_LOW
 %nonassoc LOOPEX
@@ -148,6 +146,15 @@ grammar	:	GRAMPROG
 			  newPROG(block_end($3,$4));
 			  $$ = 0;
 			}
+	|	GRAMEXPR
+			{
+			  parser->expect = XTERM;
+			}
+		optexpr
+			{
+			  PL_eval_root = $3;
+			  $$ = 0;
+			}
 	|	GRAMBLOCK
 			{
 			  parser->expect = XBLOCK;
@@ -205,12 +212,18 @@ block	:	'{' remember stmtseq '}'
 			}
 	;
 
-remember:	/* NULL */	/* start a full lexical scope */
-			{ $$ = block_start(TRUE); }
+/* format body */
+formblock:	'=' remember ';' FORMRBRACK formstmtseq ';' '.'
+			{ if (PL_parser->copline > (line_t)IVAL($1))
+			      PL_parser->copline = (line_t)IVAL($1);
+			  $$ = block_end($2, $5);
+			  TOKEN_GETMAD($1,$$,'{');
+			  TOKEN_GETMAD($7,$$,'}');
+			}
 	;
 
-mydefsv:	/* NULL */	/* lexicalize $_ */
-			{ $$ = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); }
+remember:	/* NULL */	/* start a full lexical scope */
+			{ $$ = block_start(TRUE); }
 	;
 
 mblock	:	'{' mremember stmtseq '}'
@@ -237,17 +250,45 @@ stmtseq	:	/* NULL */
 			}
 	;
 
-/* A statement in the program, including optional label */
-fullstmt:	label barestmt
+/* A sequence of format lines */
+formstmtseq:	/* NULL */
+			{ $$ = (OP*)NULL; }
+	|	formstmtseq formline
+			{   $$ = op_append_list(OP_LINESEQ, $1, $2);
+			    PL_pad_reset_pending = TRUE;
+			    if ($1 && $2)
+				PL_hints |= HINT_BLOCK_SCOPE;
+			}
+	;
+
+/* A statement in the program, including optional labels */
+fullstmt:	barestmt
 			{
-			  if (PVAL($1) || $2) {
-			      $$ = newSTATEOP(0, PVAL($1), $2);
-			      TOKEN_GETMAD($1,
-				  $2 ? cLISTOPx($$)->op_first : $$, 'L');
+			  if($1) {
+			      $$ = newSTATEOP(0, NULL, $1);
 			  } else {
-			      $$ = IF_MAD(newOP(OP_NULL, 0), $2);
+			      $$ = IF_MAD(newOP(OP_NULL, 0), NULL);
 			  }
 			}
+	|	labfullstmt
+			{ $$ = $1; }
+	;
+
+labfullstmt:	LABEL barestmt
+			{
+			  $$ = newSTATEOP(SVf_UTF8
+					   * PVAL($1)[strlen(PVAL($1))+1],
+					  PVAL($1), $2);
+			  TOKEN_GETMAD($1,
+			      $2 ? cLISTOPx($$)->op_first : $$, 'L');
+			}
+	|	LABEL labfullstmt
+			{
+			  $$ = newSTATEOP(SVf_UTF8
+					   * PVAL($1)[strlen(PVAL($1))+1],
+					  PVAL($1), $2);
+			  TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
+			}
 	;
 
 /* A bare statement, lacking label and other aspects of state op */
@@ -258,10 +299,9 @@ barestmt:	PLUGSTMT
 			  $$ = newOP(OP_NULL,0);
 			  TOKEN_GETMAD($1,$$,'p');
 			}
-	|	FORMAT startformsub formname block
+	|	FORMAT startformsub formname formblock
 			{
 			  CV *fmtcv = PL_compcv;
-			  SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
 			  $$ = newFORM($2, $3, $4);
 			  prepend_madprops($1->tk_mad, $$, 'F');
@@ -271,43 +311,60 @@ barestmt:	PLUGSTMT
 			  newFORM($2, $3, $4);
 			  $$ = (OP*)NULL;
 #endif
-			  if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
+			  if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) {
 			      SvREFCNT_inc_simple_void(fmtcv);
-			      pad_add_anon((SV*)fmtcv, OP_NULL);
+			      pad_add_anon(fmtcv, OP_NULL);
 			  }
 			}
-	|	SUB startsub subname proto subattrlist subbody
+	|	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);
+			  PL_parser->in_my = 0;
+			  PL_parser->in_my_stash = NULL;
+			}
+		proto subattrlist subbody
 			{
 			  SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
 			  {
 			      OP* o = newSVOP(OP_ANONCODE, 0,
-				(SV*)newATTRSUB($2, $3, $4, $5, $6));
+				(SV*)(
+#endif
+			  $2->op_type == OP_CONST
+			      ? newATTRSUB($3, $2, $5, $6, $7)
+			      : newMYSUB($3, $2, $5, $6, $7)
+#ifdef MAD
+				));
 			      $$ = newOP(OP_NULL,0);
 			      op_getmad(o,$$,'&');
-			      op_getmad($3,$$,'n');
-			      op_getmad($4,$$,'s');
-			      op_getmad($5,$$,'a');
+			      op_getmad($2,$$,'n');
+			      op_getmad($5,$$,'s');
+			      op_getmad($6,$$,'a');
 			      token_getmad($1,$$,'d');
-			      append_madprops($6->op_madprop, $$, 0);
-			      $6->op_madprop = 0;
+			      append_madprops($7->op_madprop, $$, 0);
+			      $7->op_madprop = 0;
 			  }
 #else
-			  newATTRSUB($2, $3, $4, $5, $6);
-			  $$ = (OP*)NULL;
-#endif
-			}
-	|	MYSUB startsub subname proto subattrlist subbody
-			{
-			  /* Unimplemented "my sub foo { }" */
-			  SvREFCNT_inc_simple_void(PL_compcv);
-#ifdef MAD
-			  $$ = newMYSUB($2, $3, $4, $5, $6);
-			  token_getmad($1,$$,'d');
-#else
-			  newMYSUB($2, $3, $4, $5, $6);
+			  ;
 			  $$ = (OP*)NULL;
 #endif
+			  intro_my();
 			}
 	|	PACKAGE WORD WORD ';'
 			{
@@ -326,7 +383,7 @@ barestmt:	PLUGSTMT
 			}
 	|	USE startsub
 			{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
-		WORD WORD listexpr ';'
+		WORD WORD optlistexpr ';'
 			{
 			  SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
@@ -341,7 +398,7 @@ barestmt:	PLUGSTMT
 			  $$ = (OP*)NULL;
 #endif
 			}
-	|	IF lpar_or_qw remember mexpr ')' mblock else
+	|	IF '(' remember mexpr ')' mblock else
 			{
 			  $$ = block_end($3,
 			      newCONDOP(0, $4, op_scope($6), $7));
@@ -350,7 +407,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($5,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	UNLESS lpar_or_qw remember miexpr ')' mblock else
+	|	UNLESS '(' remember miexpr ')' mblock else
 			{
 			  $$ = block_end($3,
 			      newCONDOP(0, $4, op_scope($6), $7));
@@ -359,17 +416,22 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($5,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	GIVEN lpar_or_qw remember mydefsv mexpr ')' mblock
+	|	GIVEN '(' remember mexpr ')' mblock
 			{
+			  const PADOFFSET offset = pad_findmy_pvs("$_", 0);
 			  $$ = block_end($3,
-				  newGIVENOP($5, op_scope($7), (PADOFFSET)$4));
+				  newGIVENOP($4, op_scope($6),
+				    offset == NOT_IN_PAD
+				    || PAD_COMPNAME_FLAGS_isOUR(offset)
+				      ? 0
+				      : offset));
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	WHEN lpar_or_qw remember mexpr ')' mblock
+	|	WHEN '(' remember mexpr ')' mblock
 			{ $$ = block_end($3, newWHENOP($4, op_scope($6))); }
 	|	DEFAULT block
 			{ $$ = newWHENOP(0, op_scope($2)); }
-	|	WHILE lpar_or_qw remember texpr ')' mintro mblock cont
+	|	WHILE '(' remember texpr ')' mintro mblock cont
 			{
 			  $$ = block_end($3,
 				  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -379,7 +441,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($5,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	UNTIL lpar_or_qw remember iexpr ')' mintro mblock cont
+	|	UNTIL '(' remember iexpr ')' mintro mblock cont
 			{
 			  $$ = block_end($3,
 				  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -389,7 +451,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($5,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	FOR lpar_or_qw remember mnexpr ';' texpr ';' mintro mnexpr ')'
+	|	FOR '(' remember mnexpr ';' texpr ';' mintro mnexpr ')'
 		mblock
 			{
 			  OP *initop = IF_MAD($4 ? $4 : newOP(OP_NULL, 0), $4);
@@ -410,7 +472,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($10,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	FOR MY remember my_scalar lpar_or_qw mexpr ')' mblock cont
+	|	FOR MY remember my_scalar '(' mexpr ')' mblock cont
 			{
 			  $$ = block_end($3, newFOROP(0, $4, $6, $8, $9));
 			  TOKEN_GETMAD($1,$$,'W');
@@ -419,7 +481,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($7,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	FOR scalar lpar_or_qw remember mexpr ')' mblock cont
+	|	FOR scalar '(' remember mexpr ')' mblock cont
 			{
 			  $$ = block_end($4, newFOROP(0,
 				      op_lvalue($2, OP_ENTERLOOP), $5, $7, $8));
@@ -428,7 +490,7 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($6,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	FOR lpar_or_qw remember mexpr ')' mblock cont
+	|	FOR '(' remember mexpr ')' mblock cont
 			{
 			  $$ = block_end($3,
 				  newFOROP(0, (OP*)NULL, $4, $6, $7));
@@ -445,15 +507,9 @@ barestmt:	PLUGSTMT
 			}
 	|	PACKAGE WORD WORD '{' remember
 			{
-			  int save_3_latefree = $3->op_latefree;
-			  $3->op_latefree = 1;
 			  package($3);
-			  $3->op_latefree = save_3_latefree;
 			  if ($2) {
-			      int save_2_latefree = $2->op_latefree;
-			      $2->op_latefree = 1;
 			      package_version($2);
-			      $2->op_latefree = save_2_latefree;
 			  }
 			}
 		stmtseq '}'
@@ -461,9 +517,6 @@ 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);
-			  op_free($3);
-			  if ($2)
-			      op_free($2);
 			  TOKEN_GETMAD($4,$$,'{');
 			  TOKEN_GETMAD($8,$$,'}');
 			  if (PL_parser->copline > (line_t)IVAL($4))
@@ -484,6 +537,36 @@ barestmt:	PLUGSTMT
 			}
 	;
 
+/* Format line */
+formline:	THING formarg
+			{ OP *list;
+			  if ($2) {
+			      OP *term = $2;
+			      DO_MAD(term = newUNOP(OP_NULL, 0, term));
+			      list = op_append_elem(OP_LIST, $1, term);
+			  }
+			  else {
+#ifdef MAD
+			      OP *op = newNULLLIST();
+			      list = op_append_elem(OP_LIST, $1, op);
+#else
+			      list = $1;
+#endif
+			  }
+			  if (PL_parser->copline == NOLINE)
+			       PL_parser->copline = CopLINE(PL_curcop)-1;
+			  else PL_parser->copline--;
+			  $$ = newSTATEOP(0, NULL,
+					  convert(OP_FORMLINE, 0, list));
+			}
+	;
+
+formarg	:	/* NULL */
+			{ $$ = NULL; }
+	|	FORMLBRACK stmtseq FORMRBRACK
+			{ $$ = op_unscope($2); }
+	;
+
 /* An expression which may have a side-effect */
 sideff	:	error
 			{ $$ = (OP*)NULL; }
@@ -523,7 +606,7 @@ else	:	/* NULL */
 			  $$ = op_scope($2);
 			  TOKEN_GETMAD($1,$$,'o');
 			}
-	|	ELSIF lpar_or_qw mexpr ')' mblock else
+	|	ELSIF '(' mexpr ')' mblock else
 			{ PL_parser->copline = (line_t)IVAL($1);
 			    $$ = newCONDOP(0,
 				newSTATEOP(OPf_SPECIAL,NULL,$3),
@@ -583,20 +666,6 @@ miexpr	:	iexpr
 			{ $$ = $1; intro_my(); }
 	;
 
-/* Optional "MAIN:"-style loop labels */
-label	:	/* empty */
-			{
-#ifdef MAD
-			  YYSTYPE tmplval;
-			  tmplval.pval = NULL;
-			  $$ = newTOKEN(OP_NULL, tmplval, 0);
-#else
-			  $$ = NULL;
-#endif
-			}
-	|	LABEL
-	;
-
 formname:	WORD		{ $$ = $1; }
 	|	/* NULL */	{ $$ = (OP*)NULL; }
 	;
@@ -618,12 +687,8 @@ startformsub:	/* NULL */	/* start a format subroutine scope */
 	;
 
 /* Name of a subroutine - must be a bareword, could be special */
-subname	:	WORD	{ const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv);
-			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
-			      || strEQ(name, "INIT") || strEQ(name, "CHECK")
-			      || strEQ(name, "UNITCHECK"))
-			      CvSPECIAL_on(PL_compcv);
-			  $$ = $1; }
+subname	:	WORD
+	|	PRIVATEREF
 	;
 
 /* Subroutine prototype */
@@ -686,11 +751,11 @@ expr	:	expr ANDOP expr
 			{ $$ = newLOGOP(OP_DOR, 0, $1, $3);
 			  TOKEN_GETMAD($2,$$,'o');
 			}
-	|	argexpr %prec PREC_LOW
+	|	listexpr %prec PREC_LOW
 	;
 
 /* Expressions are a list of terms joined by commas */
-argexpr	:	argexpr ','
+listexpr:	listexpr ','
 			{
 #ifdef MAD
 			  OP* op = newNULLLIST();
@@ -700,7 +765,7 @@ argexpr	:	argexpr ','
 			  $$ = $1;
 #endif
 			}
-	|	argexpr ',' term
+	|	listexpr ',' term
 			{ 
 			  OP* term = $3;
 			  DO_MAD(
@@ -713,7 +778,7 @@ argexpr	:	argexpr ','
 	;
 
 /* List operators */
-listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
+listop	:	LSTOP indirob listexpr /* map {...} @args or print $fh @args */
 			{ $$ = convert(IVAL($1), OPf_STACKED,
 				op_prepend_elem(OP_LIST, newGVREF(IVAL($1),$2), $3) );
 			  TOKEN_GETMAD($1,$$,'o');
@@ -725,7 +790,7 @@ listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($5,$$,')');
 			}
-	|	term ARROW method lpar_or_qw listexprcom ')' /* $foo->bar(list) */
+	|	term ARROW method '(' optexpr ')' /* $foo->bar(list) */
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
 				op_append_elem(OP_LIST,
 				    op_prepend_elem(OP_LIST, scalar($1), $5),
@@ -740,13 +805,13 @@ listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 				    newUNOP(OP_METHOD, 0, $3)));
 			  TOKEN_GETMAD($2,$$,'A');
 			}
-	|	METHOD indirob listexpr              /* new Class @args */
+	|	METHOD indirob optlistexpr           /* new Class @args */
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
 				op_append_elem(OP_LIST,
 				    op_prepend_elem(OP_LIST, $2, $3),
 				    newUNOP(OP_METHOD, 0, $1)));
 			}
-	|	FUNCMETH indirob '(' listexprcom ')' /* method $object (@args) */
+	|	FUNCMETH indirob '(' optexpr ')'    /* method $object (@args) */
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
 				op_append_elem(OP_LIST,
 				    op_prepend_elem(OP_LIST, $2, $4),
@@ -754,11 +819,11 @@ listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 			  TOKEN_GETMAD($3,$$,'(');
 			  TOKEN_GETMAD($5,$$,')');
 			}
-	|	LSTOP listexpr                       /* print @args */
+	|	LSTOP optlistexpr                    /* print @args */
 			{ $$ = convert(IVAL($1), 0, $2);
 			  TOKEN_GETMAD($1,$$,'o');
 			}
-	|	FUNC '(' listexprcom ')'             /* print (@args) */
+	|	FUNC '(' optexpr ')'                 /* print (@args) */
 			{ $$ = convert(IVAL($1), 0, $3);
 			  TOKEN_GETMAD($1,$$,'o');
 			  TOKEN_GETMAD($2,$$,'(');
@@ -767,7 +832,7 @@ listop	:	LSTOP indirob argexpr /* map {...} @args or print $fh @args */
 	|	LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
 			{ SvREFCNT_inc_simple_void(PL_compcv);
 			  $<opval>$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); }
-		    listexpr		%prec LSTOP  /* ... @bar */
+		    optlistexpr		%prec LSTOP  /* ... @bar */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				 op_append_elem(OP_LIST,
 				   op_prepend_elem(OP_LIST, $<opval>4, $5), $1));
@@ -809,7 +874,7 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
 			  TOKEN_GETMAD($2,$$,'[');
 			  TOKEN_GETMAD($4,$$,']');
 			}
-	|	scalar '{' expr ';' '}'    /* $foo->{bar();} */
+	|	scalar '{' expr ';' '}'    /* $foo{bar();} */
 			{ $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
 			    PL_parser->expect = XOPERATOR;
 			  TOKEN_GETMAD($2,$$,'{');
@@ -851,14 +916,14 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
 			  TOKEN_GETMAD($5,$$,')');
 			}
 
-	|	subscripted lpar_or_qw expr ')'   /* $foo->{bar}->(@args) */
+	|	subscripted '(' expr ')'   /* $foo->{bar}->(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				   op_append_elem(OP_LIST, $3,
 					       newCVREF(0, scalar($1))));
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	subscripted lpar_or_qw ')'        /* $foo->{bar}->() */
+	|	subscripted '(' ')'        /* $foo->{bar}->() */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				   newCVREF(0, scalar($1)));
 			  TOKEN_GETMAD($2,$$,'(');
@@ -934,7 +999,7 @@ termbinop:	term ASSIGNOP term                     /* $x = $y */
 			      op = (UNOP*)op->op_first;	/* get to flip */
 			      op = (UNOP*)op->op_first;	/* get to range */
 			      token_getmad($2,(OP*)op,'o');
-			    })
+			    });
 			}
 	|	term ANDAND term                       /* $x && $y */
 			{ $$ = newLOGOP(OP_AND, 0, $1, $3);
@@ -1042,7 +1107,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
 			  TOKEN_GETMAD($1,$$,'D');
 			}
-	|	DO WORD lpar_or_qw ')'                  /* do somesub() */
+	|	DO subname '(' ')'                  /* do somesub() */
 			{ $$ = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    op_prepend_elem(OP_LIST,
@@ -1054,7 +1119,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			  TOKEN_GETMAD($3,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	DO WORD lpar_or_qw expr ')'             /* do somesub(@args) */
+	|	DO subname '(' expr ')'             /* do somesub(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    op_append_elem(OP_LIST,
@@ -1067,7 +1132,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			  TOKEN_GETMAD($3,$$,'(');
 			  TOKEN_GETMAD($5,$$,')');
 			}
-	|	DO scalar lpar_or_qw ')'                /* do $subref () */
+	|	DO scalar '(' ')'                /* do $subref () */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    op_prepend_elem(OP_LIST,
 				scalar(newCVREF(0,scalar($2))), (OP*)NULL)); dep();
@@ -1075,7 +1140,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			  TOKEN_GETMAD($3,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	DO scalar lpar_or_qw expr ')'           /* do $subref (@args) */
+	|	DO scalar '(' expr ')'           /* do $subref (@args) */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED,
 			    op_prepend_elem(OP_LIST,
 				$4,
@@ -1154,12 +1219,12 @@ term	:	termbinop
 			{ $$ = $1; }
 	|	amper                                /* &foo; */
 			{ $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
-	|	amper lpar_or_qw ')'                 /* &foo() */
+	|	amper '(' ')'                 /* &foo() */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1));
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($3,$$,')');
 			}
-	|	amper lpar_or_qw expr ')'            /* &foo(@args) */
+	|	amper '(' expr ')'            /* &foo(@args) */
 			{
 			  $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				op_append_elem(OP_LIST, $3, scalar($1)));
@@ -1170,9 +1235,9 @@ term	:	termbinop
 			      }
 			      token_getmad($2,op,'(');
 			      token_getmad($4,op,')');
-			  })
+			  });
 			}
-	|	NOAMP WORD listexpr                  /* foo(@args) */
+	|	NOAMP subname optlistexpr               /* foo(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    op_append_elem(OP_LIST, $3, scalar($2)));
 			  TOKEN_GETMAD($1,$$,'o');
@@ -1186,7 +1251,7 @@ term	:	termbinop
 			{ $$ = newLOOPEX(IVAL($1),$2);
 			  TOKEN_GETMAD($1,$$,'o');
 			}
-	|	NOTOP argexpr                        /* not $foo */
+	|	NOTOP listexpr                       /* not $foo */
 			{ $$ = newUNOP(OP_NOT, 0, scalar($2));
 			  TOKEN_GETMAD($1,$$,'o');
 			}
@@ -1225,6 +1290,13 @@ term	:	termbinop
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($3,$$,')');
 			}
+	|	FUNC0OP       /* Same as above, but op created in toke.c */
+			{ $$ = $1; }
+	|	FUNC0OP '(' ')'
+			{ $$ = $1;
+			  TOKEN_GETMAD($2,$$,'(');
+			  TOKEN_GETMAD($3,$$,')');
+			}
 	|	FUNC0SUB                             /* Sub treated as nullop */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				scalar($1)); }
@@ -1243,10 +1315,21 @@ term	:	termbinop
 			  TOKEN_GETMAD($2,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	PMFUNC '(' argexpr ')'		/* m//, s///, tr/// */
-			{ $$ = pmruntime($1, $3, 1);
-			  TOKEN_GETMAD($2,$$,'(');
-			  TOKEN_GETMAD($4,$$,')');
+	|	PMFUNC /* m//, s///, qr//, tr/// */
+			{
+			    if (   $1->op_type != OP_TRANS
+			        && $1->op_type != OP_TRANSR
+				&& (((PMOP*)$1)->op_pmflags & PMf_HAS_CV))
+			    {
+				$<ival>$ = start_subparse(FALSE, CVf_ANON);
+				SAVEFREESV(PL_compcv);
+			    } else
+				$<ival>$ = 0;
+			}
+		    '(' listexpr ')'
+			{ $$ = pmruntime($1, $4, 1, $<ival>2);
+			  TOKEN_GETMAD($3,$$,'(');
+			  TOKEN_GETMAD($5,$$,')');
 			}
 	|	WORD
 	|	listop
@@ -1266,7 +1349,7 @@ myattrterm:	MY myterm myattrlist
 			      token_getmad($1,$$,'d');
 			      append_madprops($3->op_madprop, $$, 'a');
 			      $3->op_madprop = 0;
-			  )
+			  );
 			}
 	|	MY myterm
 			{ $$ = localize($2,IVAL($1));
@@ -1294,26 +1377,18 @@ myterm	:	'(' expr ')'
 	;
 
 /* Basic list expressions */
-listexpr:	/* NULL */ %prec PREC_LOW
+optlistexpr:	/* NULL */ %prec PREC_LOW
 			{ $$ = (OP*)NULL; }
-	|	argexpr    %prec PREC_LOW
+	|	listexpr    %prec PREC_LOW
 			{ $$ = $1; }
 	;
 
-listexprcom:	/* NULL */
+optexpr:	/* NULL */
 			{ $$ = (OP*)NULL; }
 	|	expr
 			{ $$ = $1; }
 	;
 
-lpar_or_qw:	'('
-			{ $$ = $1; }
-	|	QWLIST
-			{ munge_qwlist_to_paren_list($1); }
-		'('
-			{ $$ = $3; }
-	;
-
 /* A little bit of trickery to make "for my $foo (@bar)" actually be
    lexical */
 my_scalar:	scalar