X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4a273b91c8e47ab37c6dd310072403d4fe2d0fb9..f0af002c737e9413e85d737a29c8c9b396c13414:/perly.y?ds=sidebyside

diff --git a/perly.y b/perly.y
index c819b5b..91a7613 100644
--- a/perly.y
+++ b/perly.y
@@ -71,7 +71,7 @@
 
 %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> FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB
@@ -84,21 +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
+%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 labfullstmt barestmt block mblock else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
 %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
+%type <opval> formname subname proto subbody cont my_scalar formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> termbinop termunop anonymous termdo
+%type <opval> formstmtseq formline formarg
 
 %nonassoc <i_tkval> PREC_LOW
 %nonassoc LOOPEX
@@ -211,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 '}'
@@ -243,6 +250,17 @@ stmtseq	:	/* NULL */
 			}
 	;
 
+/* 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
 			{
@@ -258,15 +276,17 @@ fullstmt:	barestmt
 
 labfullstmt:	LABEL barestmt
 			{
-			  $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
-                                        savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+			  $$ = newSTATEOP(SVf_UTF8
+					   * PVAL($1)[strlen(PVAL($1))+1],
+					  PVAL($1), $2);
 			  TOKEN_GETMAD($1,
 			      $2 ? cLISTOPx($$)->op_first : $$, 'L');
 			}
 	|	LABEL labfullstmt
 			{
-			  $$ = newSTATEOP(SvUTF8(((SVOP*)$1)->op_sv),
-                                        savepv(SvPVX(((SVOP*)$1)->op_sv)), $2);
+			  $$ = newSTATEOP(SVf_UTF8
+					   * PVAL($1)[strlen(PVAL($1))+1],
+					  PVAL($1), $2);
 			  TOKEN_GETMAD($1, cLISTOPx($$)->op_first, 'L');
 			}
 	;
@@ -279,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');
@@ -297,38 +316,55 @@ barestmt:	PLUGSTMT
 			      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 ';'
 			{
@@ -380,10 +416,15 @@ barestmt:	PLUGSTMT
 			  TOKEN_GETMAD($5,$$,')');
 			  PL_parser->copline = (line_t)IVAL($1);
 			}
-	|	GIVEN '(' 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 '(' remember mexpr ')' mblock
@@ -466,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 '}'
@@ -482,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))
@@ -505,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; }
@@ -625,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 */
@@ -941,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);
@@ -1049,7 +1107,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));
 			  TOKEN_GETMAD($1,$$,'D');
 			}
-	|	DO WORD '(' ')'                  /* do somesub() */
+	|	DO subname '(' ')'                  /* do somesub() */
 			{ $$ = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    op_prepend_elem(OP_LIST,
@@ -1061,7 +1119,7 @@ termdo	:       DO term	%prec UNIOP                     /* do $filename */
 			  TOKEN_GETMAD($3,$$,'(');
 			  TOKEN_GETMAD($4,$$,')');
 			}
-	|	DO WORD '(' expr ')'             /* do somesub(@args) */
+	|	DO subname '(' expr ')'             /* do somesub(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB,
 			    OPf_SPECIAL|OPf_STACKED,
 			    op_append_elem(OP_LIST,
@@ -1177,9 +1235,9 @@ term	:	termbinop
 			      }
 			      token_getmad($2,op,'(');
 			      token_getmad($4,op,')');
-			  })
+			  });
 			}
-	|	NOAMP WORD optlistexpr               /* foo(@args) */
+	|	NOAMP subname optlistexpr               /* foo(@args) */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    op_append_elem(OP_LIST, $3, scalar($2)));
 			  TOKEN_GETMAD($1,$$,'o');
@@ -1291,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));