+ { $$ = NULL; }
+ ;
+
+
+
+/* --------------------------------------
+ * subroutine signature parsing
+ */
+
+/* the '' or 'foo' part of a '$' or '@foo' etc signature variable */
+sigvarname: /* NULL */
+ { parser->in_my = 0; $$ = NULL; }
+ | PRIVATEREF
+ { parser->in_my = 0; $$ = $1; }
+ ;
+
+sigslurpsigil:
+ '@'
+ { $$ = '@'; }
+ | '%'
+ { $$ = '%'; }
+
+/* @, %, @foo, %foo */
+sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
+ {
+ I32 sigil = $1;
+ OP *var = $2;
+ OP *defexpr = $3;
+
+ if (parser->sig_slurpy)
+ yyerror("Multiple slurpy parameters not allowed");
+ parser->sig_slurpy = (char)sigil;
+
+ if (defexpr)
+ yyerror("A slurpy parameter may not have "
+ "a default value");
+
+ $$ = var ? newSTATEOP(0, NULL, var) : NULL;
+ }
+ ;
+
+/* default part of sub signature scalar element: i.e. '= default_expr' */
+sigdefault: /* NULL */
+ { $$ = NULL; }
+ | ASSIGNOP
+ { $$ = newOP(OP_NULL, 0); }
+ | ASSIGNOP term
+ { $$ = $2; }
+
+
+/* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */
+sigscalarelem:
+ '$' sigvarname sigdefault
+ {
+ OP *var = $2;
+ OP *defexpr = $3;
+
+ if (parser->sig_slurpy)
+ yyerror("Slurpy parameter not last");
+
+ parser->sig_elems++;
+
+ if (defexpr) {
+ parser->sig_optelems++;
+
+ if ( defexpr->op_type == OP_NULL
+ && !(defexpr->op_flags & OPf_KIDS))
+ {
+ /* handle '$=' special case */
+ if (var)
+ yyerror("Optional parameter "
+ "lacks default expression");
+ op_free(defexpr);
+ }
+ else {
+ /* a normal '=default' expression */
+ OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+ defexpr,
+ LINKLIST(defexpr));
+ /* re-purpose op_targ to hold @_ index */
+ defop->op_targ =
+ (PADOFFSET)(parser->sig_elems - 1);
+
+ if (var) {
+ var->op_flags |= OPf_STACKED;
+ (void)op_sibling_splice(var,
+ NULL, 0, defop);
+ scalar(defop);
+ }
+ else
+ var = newUNOP(OP_NULL, 0, defop);
+
+ LINKLIST(var);
+ /* NB: normally the first child of a
+ * logop is executed before the logop,
+ * and it pushes a boolean result
+ * ready for the logop. For ARGDEFELEM,
+ * the op itself does the boolean
+ * calculation, so set the first op to
+ * it instead.
+ */
+ var->op_next = defop;
+ defexpr->op_next = var;
+ }
+ }
+ else {
+ if (parser->sig_optelems)
+ yyerror("Mandatory parameter "
+ "follows optional parameter");
+ }
+
+ $$ = var ? newSTATEOP(0, NULL, var) : NULL;
+ }
+ ;
+
+
+/* subroutine signature element: e.g. '$x = $default' or '%h' */
+sigelem: sigscalarelem
+ { parser->in_my = KEY_sigvar; $$ = $1; }
+ | sigslurpelem
+ { parser->in_my = KEY_sigvar; $$ = $1; }
+ ;
+
+/* list of subroutine signature elements */
+siglist:
+ siglist ','
+ { $$ = $1; }
+ | siglist ',' sigelem
+ {
+ $$ = op_append_list(OP_LINESEQ, $1, $3);
+ }
+ | sigelem %prec PREC_LOW
+ { $$ = $1; }
+ ;
+
+/* () or (....) */
+siglistornull: /* NULL */
+ { $$ = NULL; }
+ | siglist
+ { $$ = $1; }
+
+/* optional subroutine signature */
+optsubsignature: /* NULL */
+ { $$ = NULL; }
+ | subsignature
+ { $$ = $1; }
+
+/* Subroutine signature */
+subsignature: '(' subsigguts ')'
+ { $$ = $2; }
+
+subsigguts:
+ {
+ ENTER;
+ 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 = $2;
+ struct op_argcheck_aux *aux;
+ OP *check;
+
+ 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 = (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 */
+ 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;