net_hostent.t (was Re: [ID 20001128.002] what's the point of example code if it is...

[perl5.git] / perly.y

diff --git a/perly.y b/perly.y
index 9df012c..af0159e 100644 (file)
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,6 @@
 /*    perly.y
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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
@@ -176,7 +200,7 @@ sideff      :       error
 else   :       /* NULL */
                        { $$ = Nullop; }
        |       ELSE mblock
-                       { $$ = scope($2); }
+                       { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); }
        |       ELSIF '(' mexpr ')' mblock else
                        { PL_copline = $1;
                            $$ = newCONDOP(0, $3, scope($5), $6);
@@ -242,7 +266,7 @@ nexpr       :       /* NULL */
        ;
 
 texpr  :       /* NULL means true */
-                       { (void)scan_num("1"); $$ = yylval.opval; }
+                       { (void)scan_num("1", &yylval); $$ = yylval.opval; }
        |       expr
        ;
 
@@ -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 */
@@ -307,7 +337,7 @@ startformsub:       /* NULL */      /* start a format subroutine scope */
 
 subname        :       WORD    { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
-                             || strEQ(name, "INIT"))
+                             || strEQ(name, "INIT") || strEQ(name, "CHECK"))
                              CvSPECIAL_on(PL_compcv);
                          $$ = $1; }
        ;
@@ -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)
+