This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
put signature ops in their own subtree.
[perl5.git] / perly.y
diff --git a/perly.y b/perly.y
index 34e2264..0325d66 100644 (file)
--- a/perly.y
+++ b/perly.y
     GV *gvval;
 }
 
-%token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ
+%token <ival> GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE
 
 %token <ival> '{' '}' '[' ']' '-' '+' '@' '%' '&' '=' '.'
 
 %token <opval> BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST
 %token <opval> FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB
 %token <opval> PLUGEXPR PLUGSTMT
-%token <pval> LABEL
-%token <ival> FORMAT SUB ANONSUB PACKAGE USE
+%token <opval> LABEL
+%token <ival> FORMAT SUB SIGSUB ANONSUB ANON_SIGSUB PACKAGE USE
 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
 %token <ival> GIVEN WHEN DEFAULT
 %token <ival> LOOPEX DOTDOT YADAYADA
@@ -60,6 +60,7 @@
 %token <ival> DOLSHARP DO HASHBRACK NOAMP
 %token <ival> LOCAL MY REQUIRE
 %token <ival> COLONATTR FORMLBRACK FORMRBRACK
+%token <ival> SUBLEXSTART SUBLEXEND
 
 %type <ival> grammar remember mremember
 %type <ival>  startsub startanonsub startformsub
 %type <opval> sliceme kvslice gelem
 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr
 %type <opval> optlistexpr optexpr optrepl indirob listop method
-%type <opval> formname subname proto optsubbody cont my_scalar my_var
+%type <opval> formname subname proto cont my_scalar my_var
 %type <opval> refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> termbinop termunop anonymous termdo
 %type <ival>  sigslurpsigil
 %type <opval> sigvarname sigdefault sigscalarelem sigslurpelem
-%type <opval> sigelem siglist siglistornull subsignature 
+%type <opval> sigelem siglist siglistornull subsigguts subsignature optsubsignature
+%type <opval> subbody optsubbody sigsubbody optsigsubbody
 %type <opval> formstmtseq formline formarg
 
 %nonassoc <ival> PREC_LOW
@@ -90,7 +92,7 @@
 %left <ival> ','
 %right <ival> ASSIGNOP
 %right <ival> '?' ':'
-%nonassoc DOTDOT YADAYADA
+%nonassoc DOTDOT
 %left <ival> OROR DORDOR
 %left <ival> ANDAND
 %left <ival> BITOROP
 grammar        :       GRAMPROG
                        {
                          parser->expect = XSTATE;
+                          $<ival>$ = 0;
                        }
                remember stmtseq
                        {
@@ -127,6 +130,7 @@ grammar     :       GRAMPROG
        |       GRAMEXPR
                        {
                          parser->expect = XTERM;
+                          $<ival>$ = 0;
                        }
                optexpr
                        {
@@ -136,6 +140,7 @@ grammar     :       GRAMPROG
        |       GRAMBLOCK
                        {
                          parser->expect = XBLOCK;
+                          $<ival>$ = 0;
                        }
                block
                        {
@@ -143,11 +148,12 @@ grammar   :       GRAMPROG
                          PL_eval_root = $3;
                          $$ = 0;
                          yyunlex();
-                         parser->yychar = YYEOF;
+                         parser->yychar = yytoken = YYEOF;
                        }
        |       GRAMBARESTMT
                        {
                          parser->expect = XSTATE;
+                          $<ival>$ = 0;
                        }
                barestmt
                        {
@@ -155,11 +161,12 @@ grammar   :       GRAMPROG
                          PL_eval_root = $3;
                          $$ = 0;
                          yyunlex();
-                         parser->yychar = YYEOF;
+                         parser->yychar = yytoken = YYEOF;
                        }
        |       GRAMFULLSTMT
                        {
                          parser->expect = XSTATE;
+                          $<ival>$ = 0;
                        }
                fullstmt
                        {
@@ -167,17 +174,28 @@ grammar   :       GRAMPROG
                          PL_eval_root = $3;
                          $$ = 0;
                          yyunlex();
-                         parser->yychar = YYEOF;
+                         parser->yychar = yytoken = YYEOF;
                        }
        |       GRAMSTMTSEQ
                        {
                          parser->expect = XSTATE;
+                          $<ival>$ = 0;
                        }
                stmtseq
                        {
                          PL_eval_root = $3;
                          $$ = 0;
                        }
+       |       GRAMSUBSIGNATURE
+                       {
+                         parser->expect = XSTATE;
+                         $<ival>$ = 0;
+                       }
+               subsigguts
+                       {
+                         PL_eval_root = $3;
+                         $$ = 0;
+                       }
        ;
 
 /* An ordinary block */
@@ -215,7 +233,7 @@ mremember:  /* NULL */      /* start a partial lexical scope */
 
 /* A sequence of statements in the program */
 stmtseq        :       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       stmtseq fullstmt
                        {   $$ = op_append_list(OP_LINESEQ, $1, $2);
                            PL_pad_reset_pending = TRUE;
@@ -226,7 +244,7 @@ stmtseq     :       /* NULL */
 
 /* A sequence of format lines */
 formstmtseq:   /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       formstmtseq formline
                        {   $$ = op_append_list(OP_LINESEQ, $1, $2);
                            PL_pad_reset_pending = TRUE;
@@ -246,11 +264,17 @@ fullstmt: barestmt
 
 labfullstmt:   LABEL barestmt
                        {
-                         $$ = newSTATEOP(SVf_UTF8 * $1[strlen($1)+1], $1, $2);
+                          SV *label = cSVOPx_sv($1);
+                         $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8,
+                                            savepv(SvPVX_const(label)), $2);
+                          op_free($1);
                        }
        |       LABEL labfullstmt
                        {
-                         $$ = newSTATEOP(SVf_UTF8 * $1[strlen($1)+1], $1, $2);
+                          SV *label = cSVOPx_sv($1);
+                         $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8,
+                                            savepv(SvPVX_const(label)), $2);
+                          op_free($1);
                        }
        ;
 
@@ -261,81 +285,49 @@ barestmt: PLUGSTMT
                        {
                          CV *fmtcv = PL_compcv;
                          newFORM($2, $3, $4);
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                          if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) {
                              pad_add_weakref(fmtcv);
                          }
                          parser->parsed_sub = 1;
                        }
        |       SUB subname startsub
+                    /* sub declaration or definition not within scope
+                       of 'use feature "signatures"'*/
                        {
-                         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);
+                          init_named_cv(PL_compcv, $2);
                          parser->in_my = 0;
                          parser->in_my_stash = NULL;
                        }
-               proto subattrlist optsubbody
+                    proto subattrlist optsubbody
                        {
                          SvREFCNT_inc_simple_void(PL_compcv);
                          $2->op_type == OP_CONST
                              ? newATTRSUB($3, $2, $5, $6, $7)
                              : newMYSUB($3, $2, $5, $6, $7)
                          ;
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                          intro_my();
                          parser->parsed_sub = 1;
                        }
-       |       SUB subname startsub
+       |       SIGSUB subname startsub
+                    /* sub declaration or definition under 'use feature
+                     * "signatures"'. (Note that a signature isn't
+                     * allowed in a declaration)
+                     */
                        {
-                         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);
+                          init_named_cv(PL_compcv, $2);
                          parser->in_my = 0;
                          parser->in_my_stash = NULL;
                        }
-               remember subsignature subattrlist '{' stmtseq '}'
+                    subattrlist optsigsubbody
                        {
-                         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)
+                             ? newATTRSUB($3, $2, NULL, $5, $6)
+                             : newMYSUB(  $3, $2, NULL, $5, $6)
                          ;
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                          intro_my();
                          parser->parsed_sub = 1;
                        }
@@ -344,7 +336,7 @@ barestmt:   PLUGSTMT
                          package($3);
                          if ($2)
                              package_version($2);
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                        }
        |       USE startsub
                        { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
@@ -353,7 +345,7 @@ barestmt:   PLUGSTMT
                          SvREFCNT_inc_simple_void(PL_compcv);
                          utilize($1, $2, $4, $5, $6);
                          parser->parsed_sub = 1;
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                        }
        |       IF '(' remember mexpr ')' mblock else
                        {
@@ -379,14 +371,14 @@ barestmt: PLUGSTMT
        |       WHILE '(' remember texpr ')' mintro mblock cont
                        {
                          $$ = block_end($3,
-                                 newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
+                                 newWHILEOP(0, 1, NULL,
                                      $4, $7, $8, $6));
                          parser->copline = (line_t)$1;
                        }
        |       UNTIL '(' remember iexpr ')' mintro mblock cont
                        {
                          $$ = block_end($3,
-                                 newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
+                                 newWHILEOP(0, 1, NULL,
                                      $4, $7, $8, $6));
                          parser->copline = (line_t)$1;
                        }
@@ -398,7 +390,7 @@ barestmt:   PLUGSTMT
                mblock
                        {
                          OP *initop = $4;
-                         OP *forop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
+                         OP *forop = newWHILEOP(0, 1, NULL,
                                      scalar($7), $13, $11, $10);
                          if (initop) {
                              forop = op_prepend_elem(OP_LINESEQ, initop,
@@ -447,14 +439,14 @@ barestmt: PLUGSTMT
        |       FOR '(' remember mexpr ')' mblock cont
                        {
                          $$ = block_end($3,
-                                 newFOROP(0, (OP*)NULL, $4, $6, $7));
+                                 newFOROP(0, NULL, $4, $6, $7));
                          parser->copline = (line_t)$1;
                        }
        |       block cont
                        {
                          /* a block is a loop that happens once */
-                         $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                 (OP*)NULL, $1, $2, 0);
+                         $$ = newWHILEOP(0, 1, NULL,
+                                 NULL, $1, $2, 0);
                        }
        |       PACKAGE BAREWORD BAREWORD '{' remember
                        {
@@ -466,8 +458,8 @@ barestmt:   PLUGSTMT
                stmtseq '}'
                        {
                          /* a block is a loop that happens once */
-                         $$ = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
-                                 (OP*)NULL, block_end($5, $7), (OP*)NULL, 0);
+                         $$ = newWHILEOP(0, 1, NULL,
+                                 NULL, block_end($5, $7), NULL, 0);
                          if (parser->copline > (line_t)$4)
                              parser->copline = (line_t)$4;
                        }
@@ -475,9 +467,14 @@ barestmt:  PLUGSTMT
                        {
                          $$ = $1;
                        }
+       |       YADAYADA ';'
+                       {
+                         $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
+                               newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
+                       }
        |       ';'
                        {
-                         $$ = (OP*)NULL;
+                         $$ = NULL;
                          parser->copline = NOLINE;
                        }
        ;
@@ -508,7 +505,7 @@ formarg     :       /* NULL */
 
 /* An expression which may have a side-effect */
 sideff :       error
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       expr
                        { $$ = $1; }
        |       expr IF expr
@@ -520,7 +517,7 @@ sideff      :       error
        |       expr UNTIL iexpr
                        { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1); }
        |       expr FOR expr
-                       { $$ = newFOROP(0, (OP*)NULL, $3, $1, (OP*)NULL);
+                       { $$ = newFOROP(0, NULL, $3, $1, NULL);
                          parser->copline = (line_t)$2; }
        |       expr WHEN expr
                        { $$ = newWHENOP($3, op_scope($1)); }
@@ -528,7 +525,7 @@ sideff      :       error
 
 /* else and elsif blocks */
 else   :       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       ELSE mblock
                        {
                          ($2)->op_flags |= OPf_PARENS;
@@ -545,7 +542,7 @@ else        :       /* NULL */
 
 /* Continue blocks */
 cont   :       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       CONTINUE block
                        { $$ = op_scope($2); }
        ;
@@ -558,7 +555,7 @@ mintro      :       /* NULL */
 
 /* Normal expression */
 nexpr  :       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       sideff
        ;
 
@@ -585,7 +582,7 @@ mnexpr      :       nexpr
        ;
 
 formname:      BAREWORD        { $$ = $1; }
-       |       /* NULL */      { $$ = (OP*)NULL; }
+       |       /* NULL */      { $$ = NULL; }
        ;
 
 startsub:      /* NULL */      /* start a regular subroutine scope */
@@ -611,24 +608,24 @@ subname   :       BAREWORD
 
 /* Subroutine prototype */
 proto  :       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       THING
        ;
 
 /* Optional list of subroutine attributes */
 subattrlist:   /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       COLONATTR THING
                        { $$ = $2; }
        |       COLONATTR
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        ;
 
 /* List of attributes for a "my" variable declaration */
 myattrlist:    COLONATTR THING
                        { $$ = $2; }
        |       COLONATTR
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        ;
 
 
@@ -638,10 +635,10 @@ myattrlist:       COLONATTR THING
  */
 
 /* the '' or 'foo' part of a '$' or '@foo' etc signature variable  */
-sigvarname:   /* NULL */
-                       { $$ = (OP*)NULL; }
+sigvarname:     /* NULL */
+                       { parser->in_my = 0; $$ = NULL; }
         |       PRIVATEREF
-                        { $$ = $1; }
+                        { parser->in_my = 0; $$ = $1; }
        ;
 
 sigslurpsigil:
@@ -657,21 +654,21 @@ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
                             OP *var     = $2;
                             OP *defexpr = $3;
 
-                            if (PL_parser->sig_slurpy)
+                            if (parser->sig_slurpy)
                                 yyerror("Multiple slurpy parameters not allowed");
-                            PL_parser->sig_slurpy = sigil;
+                            parser->sig_slurpy = (char)sigil;
 
                             if (defexpr)
                                 yyerror("A slurpy parameter may not have "
                                         "a default value");
 
-                            $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                            $$ = var ? newSTATEOP(0, NULL, var) : NULL;
                         }
        ;
 
 /* default part of sub signature scalar element: i.e. '= default_expr' */
 sigdefault:    /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
         |       ASSIGNOP
                         { $$ = newOP(OP_NULL, 0); }
         |       ASSIGNOP term
@@ -685,13 +682,13 @@ sigscalarelem:
                             OP *var     = $2;
                             OP *defexpr = $3;
 
-                            if (PL_parser->sig_slurpy)
+                            if (parser->sig_slurpy)
                                 yyerror("Slurpy parameter not last");
 
-                            PL_parser->sig_elems++;
+                            parser->sig_elems++;
 
                             if (defexpr) {
-                                PL_parser->sig_optelems++;
+                                parser->sig_optelems++;
 
                                 if (   defexpr->op_type == OP_NULL
                                     && !(defexpr->op_flags & OPf_KIDS))
@@ -708,7 +705,8 @@ sigscalarelem:
                                                         defexpr,
                                                         LINKLIST(defexpr));
                                     /* re-purpose op_targ to hold @_ index */
-                                    defop->op_targ = PL_parser->sig_elems - 1;
+                                    defop->op_targ =
+                                        (PADOFFSET)(parser->sig_elems - 1);
 
                                     if (var) {
                                         var->op_flags |= OPf_STACKED;
@@ -733,21 +731,21 @@ sigscalarelem:
                                 }
                             }
                             else {
-                                if (PL_parser->sig_optelems)
+                                if (parser->sig_optelems)
                                     yyerror("Mandatory parameter "
                                             "follows optional parameter");
                             }
 
-                            $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                            $$ = var ? newSTATEOP(0, NULL, var) : NULL;
                         }
        ;
 
 
 /* subroutine signature element: e.g. '$x = $default' or '%h' */
 sigelem:        sigscalarelem
-                        { parser->expect = XSIGVAR; $$ = $1; }
+                        { parser->in_my = KEY_sigvar; $$ = $1; }
         |       sigslurpelem
-                        { parser->expect = XSIGVAR; $$ = $1; }
+                        { parser->in_my = KEY_sigvar; $$ = $1; }
        ;
 
 /* list of subroutine signature elements */
@@ -764,64 +762,120 @@ siglist:
 
 /* () or (....) */
 siglistornull:         /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       siglist
                        { $$ = $1; }
 
+/* optional subroutine signature */
+optsubsignature:       /* NULL */
+                       { $$ = NULL; }
+       |       subsignature
+                       { $$ = $1; }
+
 /* Subroutine signature */
-subsignature:  '('
+subsignature:  '(' subsigguts ')'
+                       { $$ = $2; }
+
+subsigguts:
                         {
                             ENTER;
-                            SAVEINT(PL_parser->sig_elems);
-                            SAVEINT(PL_parser->sig_optelems);
-                            SAVEI8(PL_parser->sig_slurpy);
-                            PL_parser->sig_elems    = 0;
-                            PL_parser->sig_optelems = 0;
-                            PL_parser->sig_slurpy   = 0;
-                            parser->expect = XSIGVAR;
+                            SAVEIV(parser->sig_elems);
+                            SAVEIV(parser->sig_optelems);
+                            SAVEI8(parser->sig_slurpy);
+                            parser->sig_elems    = 0;
+                            parser->sig_optelems = 0;
+                            parser->sig_slurpy   = 0;
+                            parser->in_my        = KEY_sigvar;
                         }
                 siglistornull
-                ')'
                        {
-                            OP            *sigops = $3;
-                            UNOP_AUX_item *aux;
+                            OP            *sigops = $2;
+                            struct op_argcheck_aux *aux;
                             OP            *check;
 
-                            assert(FEATURE_SIGNATURES_IS_ENABLED);
+                           if (!FEATURE_SIGNATURES_IS_ENABLED)
+                               Perl_croak(aTHX_ "Experimental "
+                                    "subroutine signatures not enabled");
 
                             /* We shouldn't get here otherwise */
                             Perl_ck_warner_d(aTHX_
                                 packWARN(WARN_EXPERIMENTAL__SIGNATURES),
                                 "The signatures feature is experimental");
 
-                            aux = (UNOP_AUX_item*)PerlMemShared_malloc(
-                                sizeof(UNOP_AUX_item) * 3);
-                            aux[0].uv = PL_parser->sig_elems;
-                            aux[1].uv = PL_parser->sig_optelems;
-                            aux[2].iv = PL_parser->sig_slurpy;
-                            check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+                            aux = (struct op_argcheck_aux*)
+                                    PerlMemShared_malloc(
+                                        sizeof(struct op_argcheck_aux));
+                            aux->params     = parser->sig_elems;
+                            aux->opt_params = parser->sig_optelems;
+                            aux->slurpy     = parser->sig_slurpy;
+                            check = newUNOP_AUX(OP_ARGCHECK, 0, NULL,
+                                            (UNOP_AUX_item *)aux);
                             sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
                             sigops = op_prepend_elem(OP_LINESEQ,
                                                 newSTATEOP(0, NULL, NULL),
                                                 sigops);
                             /* a nextstate at the end handles context
                              * correctly for an empty sub body */
-                            $$ = op_append_elem(OP_LINESEQ,
+                            sigops = op_append_elem(OP_LINESEQ,
                                                 sigops,
                                                 newSTATEOP(0, NULL, NULL));
-
+                            /* wrap the list of arg ops in a NULL aux op.
+                              This serves two purposes. First, it makes
+                              the arg list a separate subtree from the
+                              body of the sub, and secondly the null op
+                              may in future be upgraded to an OP_SIGNATURE
+                              when implemented. For now leave it as
+                              ex-argcheck */
+                            $$ = newUNOP_AUX(OP_ARGCHECK, 0, sigops, NULL);
+                            op_null($$);
+
+                            parser->in_my = 0;
+                            /* tell the toker that attrributes can follow
+                             * this sig, but only so that the toker
+                             * can skip through any (illegal) trailing
+                             * attribute text then give a useful error
+                             * message about "attributes before sig",
+                             * rather than falling over ina mess at
+                             * unrecognised syntax.
+                             */
                             parser->expect = XATTRBLOCK;
+                            parser->sig_seen = TRUE;
                             LEAVE;
                        }
        ;
 
+/* Optional subroutine body (for named subroutine declaration) */
+optsubbody:    subbody { $$ = $1; }
+       |       ';'     { $$ = NULL; }
+       ;
 
 
-/* Optional subroutine body, for named subroutine declaration */
-optsubbody:    block
-       |       ';'     { $$ = (OP*)NULL; }
+/* Subroutine body (without signature) */
+subbody:       remember  '{' stmtseq '}'
+                       {
+                         if (parser->copline > (line_t)$2)
+                             parser->copline = (line_t)$2;
+                         $$ = block_end($1, $3);
+                       }
        ;
 
+
+/* optional [ Subroutine body with optional signature ] (for named
+ * subroutine declaration) */
+optsigsubbody: sigsubbody { $$ = $1; }
+       |       ';'        { $$ = NULL; }
+
+/* Subroutine body with optional signature */
+sigsubbody:    remember optsubsignature '{' stmtseq '}'
+                       {
+                         if (parser->copline > (line_t)$3)
+                             parser->copline = (line_t)$3;
+                         $$ = block_end($1,
+                               op_append_list(OP_LINESEQ, $2, $4));
+                       }
+       ;
+
+
 /* Ordinary expressions; logical combinations */
 expr   :       expr ANDOP expr
                        { $$ = newLOGOP(OP_AND, 0, $1, $3); }
@@ -879,9 +933,11 @@ listop     :       LSTOP indirob listexpr /* map {...} @args or print $fh @args */
                        { $$ = op_convert_list($1, 0, $2); }
        |       FUNC '(' optexpr ')'                 /* print (@args) */
                        { $$ = op_convert_list($1, 0, $3); }
+       |       FUNC SUBLEXSTART optexpr SUBLEXEND          /* uc($arg) from "\U..." */
+                       { $$ = op_convert_list($1, 0, $3); }
        |       LSTOPSUB startanonsub block /* sub f(&@);   f { foo } ... */
                        { SvREFCNT_inc_simple_void(PL_compcv);
-                         $<opval>$ = newANONATTRSUB($2, 0, (OP*)NULL, $3); }
+                         $<opval>$ = newANONATTRSUB($2, 0, NULL, $3); }
                    optlistexpr         %prec LSTOP  /* ... @bar */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                 op_append_elem(OP_LIST,
@@ -925,29 +981,41 @@ subscripted:    gelem '{' expr ';' '}'        /* *main::{something} */
                                        jmaybe($3)); }
        |       term ARROW '(' ')'          /* $subref->() */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                                  newCVREF(0, scalar($1))); }
+                                  newCVREF(0, scalar($1)));
+                         if (parser->expect == XBLOCK)
+                             parser->expect = XOPERATOR;
+                       }
        |       term ARROW '(' expr ')'     /* $subref->(@args) */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   op_append_elem(OP_LIST, $4,
-                                      newCVREF(0, scalar($1)))); }
+                                      newCVREF(0, scalar($1))));
+                         if (parser->expect == XBLOCK)
+                             parser->expect = XOPERATOR;
+                       }
 
        |       subscripted '(' expr ')'   /* $foo->{bar}->(@args) */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   op_append_elem(OP_LIST, $3,
-                                              newCVREF(0, scalar($1)))); }
+                                              newCVREF(0, scalar($1))));
+                         if (parser->expect == XBLOCK)
+                             parser->expect = XOPERATOR;
+                       }
        |       subscripted '(' ')'        /* $foo->{bar}->() */
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                                  newCVREF(0, scalar($1))); }
+                                  newCVREF(0, scalar($1)));
+                         if (parser->expect == XBLOCK)
+                             parser->expect = XOPERATOR;
+                       }
        |       '(' expr ')' '[' expr ']'            /* list slice */
                        { $$ = newSLICEOP(0, $5, $2); }
        |       QWLIST '[' expr ']'            /* list literal slice */
                        { $$ = newSLICEOP(0, $3, $1); }
        |       '(' ')' '[' expr ']'                 /* empty list slice! */
-                       { $$ = newSLICEOP(0, $4, (OP*)NULL); }
+                       { $$ = newSLICEOP(0, $4, NULL); }
     ;
 
 /* Binary operators between terms */
-termbinop:     term ASSIGNOP term                     /* $x = $y */
+termbinop:     term ASSIGNOP term                     /* $x = $y, $x += $y */
                        { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); }
        |       term POWOP term                        /* $x ** $y */
                        { $$ = newBINOP($2, 0, scalar($1), scalar($3)); }
@@ -1020,25 +1088,17 @@ termunop : '-' term %prec UMINUS                       /* -$x */
 anonymous:     '[' expr ']'
                        { $$ = newANONLIST($2); }
        |       '[' ']'
-                       { $$ = newANONLIST((OP*)NULL);}
+                       { $$ = newANONLIST(NULL);}
        |       HASHBRACK expr ';' '}'  %prec '(' /* { foo => "Bar" } */
                        { $$ = newANONHASH($2); }
        |       HASHBRACK ';' '}'       %prec '(' /* { } (';' by tokener) */
-                       { $$ = newANONHASH((OP*)NULL); }
-       |       ANONSUB startanonsub proto subattrlist block            %prec '('
+                       { $$ = newANONHASH(NULL); }
+       |       ANONSUB     startanonsub proto subattrlist subbody    %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);
-                       }
-
+       |       ANON_SIGSUB startanonsub subattrlist sigsubbody %prec '('
+                       { SvREFCNT_inc_simple_void(PL_compcv);
+                         $$ = newANONATTRSUB($2, NULL, $3, $4); }
     ;
 
 /* Things called with "do" */
@@ -1196,15 +1256,10 @@ term    :       termbinop
                            } else
                                $<ival>$ = 0;
                        }
-                   '(' listexpr optrepl ')'
+                   SUBLEXSTART listexpr optrepl SUBLEXEND
                        { $$ = pmruntime($1, $4, $5, 1, $<ival>2); }
        |       BAREWORD
        |       listop
-       |       YADAYADA
-                       {
-                         $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
-                               newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
-                       }
        |       PLUGEXPR
        ;
 
@@ -1233,19 +1288,19 @@ myterm  :       '(' expr ')'
 
 /* Basic list expressions */
 optlistexpr:   /* NULL */ %prec PREC_LOW
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       listexpr    %prec PREC_LOW
                        { $$ = $1; }
        ;
 
 optexpr:       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       expr
                        { $$ = $1; }
        ;
 
 optrepl:       /* NULL */
-                       { $$ = (OP*)NULL; }
+                       { $$ = NULL; }
        |       '/' expr
                        { $$ = $2; }
        ;