This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
document fields of regmatch_info struct
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 9143341..0f98f59 100644 (file)
--- 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
 %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');
@@ -292,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(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,
@@ -1161,12 +1219,12 @@ term    :       termbinop
                        { $$ = $1; }
        |       amper                                /* &foo; */
                        { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); }
-       |       amper '(' ')'                 /* &foo() */
+       |       amper '(' ')'                 /* &foo() or foo() */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1));
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($3,$$,')');
                        }
-       |       amper '(' expr ')'            /* &foo(@args) */
+       |       amper '(' expr ')'          /* &foo(@args) or foo(@args) */
                        {
                          $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST, $3, scalar($1)));
@@ -1177,9 +1235,9 @@ term      :       termbinop
                              }
                              token_getmad($2,op,'(');
                              token_getmad($4,op,')');
-                         })
+                         });
                        }
-       |       NOAMP WORD optlistexpr               /* foo(@args) */
+       |       NOAMP subname optlistexpr       /* foo @args (no parens) */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            op_append_elem(OP_LIST, $3, scalar($2)));
                          TOKEN_GETMAD($1,$$,'o');
@@ -1257,10 +1315,21 @@ term    :       termbinop
                          TOKEN_GETMAD($2,$$,'(');
                          TOKEN_GETMAD($4,$$,')');
                        }
-       |       PMFUNC '(' listexpr ')'         /* 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
@@ -1280,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));