sub : attrlist

To: Mailing list Perl5 <perl5-porters@perl.org>
Message-Id: <199908290702.DAA32191@Orb.Nashua.NH.US>

p4raw-id: //depot/cfgperl@4043

1 files changed, 83 insertions, 15 deletions

diff --git a/perly.y b/perly.y
index 9df012c3aa..ddc0efcb6d 100644
--- a/perly.y
+++ b/perly.y
@@ -19,13 +19,34 @@
 
 #define dep() deprecate("\"do\" to call subroutines")
 
+/* stuff included here to make perly_c.diff apply better */
+
+#define yydebug	    PL_yydebug
+#define yynerrs	    PL_yynerrs
+#define yyerrflag   PL_yyerrflag
+#define yychar	    PL_yychar
+#define yyval	    PL_yyval
+#define yylval	    PL_yylval
+
+struct ysv {
+    short* yyss;
+    YYSTYPE* yyvs;
+    int oldyydebug;
+    int oldyynerrs;
+    int oldyyerrflag;
+    int oldyychar;
+    YYSTYPE oldyyval;
+    YYSTYPE oldyylval;
+};
+
+static void yydestruct(pTHXo_ void *ptr);
+
 %}
 
 %start prog
 
 %{
-/* I sense a Big Blue pattern here... */
-#if !defined(OEMVS) && !defined(__OPEN_VM) && !defined(POSIX_BC)
+#if 0 /* get this from perly.h instead */
 %}
 
 %union {
@@ -36,11 +57,12 @@
 }
 
 %{
-#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */
+#endif /* 0 */
 
 #ifdef USE_PURE_BISON
 #define YYLEX_PARAM (&yychar)
 #endif
+
 %}
 
 %token <ival> '{'
@@ -54,15 +76,17 @@
 %token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
 %token <ival> RELOP EQOP MULOP ADDOP
 %token <ival> DOLSHARP DO HASHBRACK NOAMP
-%token LOCAL MY
+%token <ival> LOCAL MY MYSUB
+%token COLONATTR
 
-%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> prog decl format startsub startanonsub startformsub
 %type <ival> remember mremember '&'
 %type <opval> block mblock lineseq line loop cond else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
 %type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
 %type <opval> listexpr listexprcom indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar
+%type <opval> subattrlist myattrlist mysubrout myattrterm myterm
 %type <pval> label
 
 %nonassoc PREC_LOW
@@ -275,6 +299,8 @@ decl	:	format
 			{ $$ = 0; }
 	|	subrout
 			{ $$ = 0; }
+	|	mysubrout
+			{ $$ = 0; }
 	|	package
 			{ $$ = 0; }
 	|	use
@@ -289,8 +315,12 @@ formname:	WORD		{ $$ = $1; }
 	|	/* NULL */	{ $$ = Nullop; }
 	;
 
-subrout	:	SUB startsub subname proto subbody
-			{ newSUB($2, $3, $4, $5); }
+mysubrout:	MYSUB startsub subname proto subattrlist subbody
+			{ newMYSUB($2, $3, $4, $5, $6); }
+	;
+
+subrout	:	SUB startsub subname proto subattrlist subbody
+			{ newATTRSUB($2, $3, $4, $5, $6); }
 	;
 
 startsub:	/* NULL */	/* start a regular subroutine scope */
@@ -317,6 +347,20 @@ proto	:	/* NULL */
 	|	THING
 	;
 
+subattrlist:	/* NULL */
+			{ $$ = Nullop; }
+	|	COLONATTR THING
+			{ $$ = $2; }
+	|	COLONATTR
+			{ $$ = Nullop; }
+	;
+
+myattrlist:	COLONATTR THING
+			{ $$ = $2; }
+	|	COLONATTR
+			{ $$ = Nullop; }
+	;
+
 subbody	:	block	{ $$ = $1; }
 	|	';'	{ $$ = Nullop; PL_expect = XSTATE; }
 	;
@@ -377,7 +421,7 @@ listop	:	LSTOP indirob argexpr
 	|	FUNC '(' listexprcom ')'
 			{ $$ = convert($1, 0, $3); }
 	|	LSTOPSUB startanonsub block
-			{ $3 = newANONSUB($2, 0, $3); }
+			{ $3 = newANONATTRSUB($2, 0, Nullop, $3); }
 		    listexpr		%prec LSTOP
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				 append_elem(OP_LIST,
@@ -484,7 +528,9 @@ term	:	term ASSIGNOP term
 	|	PREDEC term
 			{ $$ = newUNOP(OP_PREDEC, 0,
 					mod(scalar($2), OP_PREDEC)); }
-	|	local term	%prec UNIOP
+	|	myattrterm	%prec UNIOP
+			{ $$ = $1; }
+	|	LOCAL term	%prec UNIOP
 			{ $$ = localize($2,$1); }
 	|	'(' expr ')'
 			{ $$ = sawparens($2); }
@@ -498,8 +544,8 @@ term	:	term ASSIGNOP term
 			{ $$ = newANONHASH($2); }
 	|	HASHBRACK ';' '}'				%prec '('
 			{ $$ = newANONHASH(Nullop); }
-	|	ANONSUB startanonsub proto block		%prec '('
-			{ $$ = newANONSUB($2, $3, $4); }
+	|	ANONSUB startanonsub proto subattrlist block	%prec '('
+			{ $$ = newANONATTRSUB($2, $3, $4, $5); }
 	|	scalar	%prec '('
 			{ $$ = $1; }
 	|	star	%prec '('
@@ -606,6 +652,24 @@ term	:	term ASSIGNOP term
 	|	listop
 	;
 
+myattrterm:	MY myterm myattrlist
+			{ $$ = my_attrs($2,$3); }
+	|	MY myterm
+			{ $$ = localize($2,$1); }
+	;
+
+myterm	:	'(' expr ')'
+			{ $$ = sawparens($2); }
+	|	'(' ')'
+			{ $$ = sawparens(newNULLLIST()); }
+	|	scalar	%prec '('
+			{ $$ = $1; }
+	|	hsh 	%prec '('
+			{ $$ = $1; }
+	|	ary 	%prec '('
+			{ $$ = $1; }
+	;
+
 listexpr:	/* NULL */ %prec PREC_LOW
 			{ $$ = Nullop; }
 	|	argexpr    %prec PREC_LOW
@@ -620,10 +684,6 @@ listexprcom:	/* NULL */
 			{ $$ = $1; }
 	;
 
-local	:	LOCAL	{ $$ = 0; }
-	|	MY	{ $$ = 1; }
-	;
-
 my_scalar:	scalar
 			{ PL_in_my = 0; $$ = my($1); }
 	;
@@ -664,3 +724,11 @@ indirob	:	WORD
 	;
 
 %% /* PROGRAM */
+
+/* more stuff added to make perly_c.diff easier to apply */
+
+#ifdef yyparse
+#undef yyparse
+#endif
+#define yyparse() Perl_yyparse(pTHX)
+