Don't quit before printing out the message.
[p5sagit/p5-mst-13.2.git] / perly.y
diff --git a/perly.y b/perly.y
index 4c4f67a..9df012c 100644 (file)
--- a/perly.y
+++ b/perly.y
 
 %{
 #include "EXTERN.h"
+#define PERL_IN_PERLY_C
 #include "perl.h"
 
-static void
-dep()
-{
-    deprecate("\"do\" to call subroutines");
-}
+#define dep() deprecate("\"do\" to call subroutines")
 
 %}
 
 %start prog
 
+%{
+/* I sense a Big Blue pattern here... */
+#if !defined(OEMVS) && !defined(__OPEN_VM) && !defined(POSIX_BC)
+%}
+
 %union {
     I32        ival;
     char *pval;
@@ -33,7 +35,15 @@ dep()
     GV *gvval;
 }
 
-%token <ival> '{' ')'
+%{
+#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */
+
+#ifdef USE_PURE_BISON
+#define YYLEX_PARAM (&yychar)
+#endif
+%}
+
+%token <ival> '{'
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
 %token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
@@ -49,12 +59,15 @@ dep()
 %type <ival> prog decl local format startsub startanonsub startformsub
 %type <ival> remember mremember '&'
 %type <opval> block mblock lineseq line loop cond else
-%type <opval> expr term scalar ary hsh arylen star amper sideff
+%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 <pval> label
 
+%nonassoc PREC_LOW
+%nonassoc LOOPEX
+
 %left <ival> OROP
 %left ANDOP
 %right NOTOP
@@ -78,24 +91,26 @@ dep()
 %right <ival> POWOP
 %nonassoc PREINC PREDEC POSTINC POSTDEC
 %left ARROW
+%nonassoc <ival> ')'
 %left '('
+%left '[' '{'
 
 %% /* RULES */
 
 prog   :       /* NULL */
                {
 #if defined(YYDEBUG) && defined(DEBUGGING)
-                   yydebug = (debug & 1);
+                   yydebug = (PL_debug & 1);
 #endif
-                   expect = XSTATE;
+                   PL_expect = XSTATE;
                }
        /*CONTINUED*/   lineseq
                        { newPROG($2); }
        ;
 
 block  :       '{' remember lineseq '}'
-                       { if (copline > (line_t)$1)
-                             copline = $1;
+                       { if (PL_copline > (line_t)$1)
+                             PL_copline = $1;
                          $$ = block_end($2, $3); }
        ;
 
@@ -104,8 +119,8 @@ remember:   /* NULL */      /* start a full lexical scope */
        ;
 
 mblock :       '{' mremember lineseq '}'
-                       { if (copline > (line_t)$1)
-                             copline = $1;
+                       { if (PL_copline > (line_t)$1)
+                             PL_copline = $1;
                          $$ = block_end($2, $3); }
        ;
 
@@ -120,8 +135,8 @@ lineseq     :       /* NULL */
        |       lineseq line
                        {   $$ = append_list(OP_LINESEQ,
                                (LISTOP*)$1, (LISTOP*)$2);
-                           pad_reset_pending = TRUE;
-                           if ($1 && $2) hints |= HINT_BLOCK_SCOPE; }
+                           PL_pad_reset_pending = TRUE;
+                           if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; }
        ;
 
 line   :       label cond
@@ -133,12 +148,12 @@ line      :       label cond
                            }
                            else {
                              $$ = Nullop;
-                             copline = NOLINE;
+                             PL_copline = NOLINE;
                            }
-                           expect = XSTATE; }
+                           PL_expect = XSTATE; }
        |       label sideff ';'
                        { $$ = newSTATEOP(0, $1, $2);
-                         expect = XSTATE; }
+                         PL_expect = XSTATE; }
        ;
 
 sideff :       error
@@ -153,6 +168,9 @@ sideff      :       error
                        { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
        |       expr UNTIL iexpr
                        { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
+       |       expr FOR expr
+                       { $$ = newFOROP(0, Nullch, $2,
+                                       Nullop, $3, $1, Nullop); }
        ;
 
 else   :       /* NULL */
@@ -160,18 +178,17 @@ else      :       /* NULL */
        |       ELSE mblock
                        { $$ = scope($2); }
        |       ELSIF '(' mexpr ')' mblock else
-                       { copline = $1;
-                           $$ = newSTATEOP(0, Nullch,
-                                  newCONDOP(0, $3, scope($5), $6));
-                           hints |= HINT_BLOCK_SCOPE; }
+                       { PL_copline = $1;
+                           $$ = newCONDOP(0, $3, scope($5), $6);
+                           PL_hints |= HINT_BLOCK_SCOPE; }
        ;
 
 cond   :       IF '(' remember mexpr ')' mblock else
-                       { copline = $1;
+                       { PL_copline = $1;
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7)); }
        |       UNLESS '(' remember miexpr ')' mblock else
-                       { copline = $1;
+                       { PL_copline = $1;
                            $$ = block_end($3,
                                   newCONDOP(0, $4, scope($6), $7)); }
        ;
@@ -183,13 +200,13 @@ cont      :       /* NULL */
        ;
 
 loop   :       label WHILE '(' remember mtexpr ')' mblock cont
-                       { copline = $2;
+                       { PL_copline = $2;
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
                                                $2, $5, $7, $8))); }
        |       label UNTIL '(' remember miexpr ')' mblock cont
-                       { copline = $2;
+                       { PL_copline = $2;
                            $$ = block_end($4,
                                   newSTATEOP(0, $1,
                                     newWHILEOP(0, 1, (LOOP*)Nullop,
@@ -211,7 +228,7 @@ loop        :       label WHILE '(' remember mtexpr ')' mblock cont
                                        newWHILEOP(0, 1, (LOOP*)Nullop,
                                                   $2, scalar($7),
                                                   $11, scalar($9)));
-                         copline = $2;
+                         PL_copline = $2;
                          $$ = block_end($4, newSTATEOP(0, $1, forop)); }
        |       label block cont  /* a block is a loop that happens once */
                        { $$ = newSTATEOP(0, $1,
@@ -288,10 +305,10 @@ startformsub:     /* NULL */      /* start a format subroutine scope */
                        { $$ = start_subparse(TRUE, 0); }
        ;
 
-subname        :       WORD    { char *name = SvPV(((SVOP*)$1)->op_sv, na);
+subname        :       WORD    { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
                          if (strEQ(name, "BEGIN") || strEQ(name, "END")
                              || strEQ(name, "INIT"))
-                             CvUNIQUE_on(compcv);
+                             CvSPECIAL_on(PL_compcv);
                          $$ = $1; }
        ;
 
@@ -301,7 +318,7 @@ proto       :       /* NULL */
        ;
 
 subbody        :       block   { $$ = $1; }
-       |       ';'     { $$ = Nullop; expect = XSTATE; }
+       |       ';'     { $$ = Nullop; PL_expect = XSTATE; }
        ;
 
 package :      PACKAGE WORD ';'
@@ -311,7 +328,7 @@ package :   PACKAGE WORD ';'
        ;
 
 use    :       USE startsub
-                       { CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+                       { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
                    WORD WORD listexpr ';'
                        { utilize($1, $2, $4, $5, $6); }
        ;
@@ -320,14 +337,14 @@ expr      :       expr ANDOP expr
                        { $$ = newLOGOP(OP_AND, 0, $1, $3); }
        |       expr OROP expr
                        { $$ = newLOGOP($2, 0, $1, $3); }
-       |       argexpr
+       |       argexpr %prec PREC_LOW
        ;
 
 argexpr        :       argexpr ','
                        { $$ = $1; }
        |       argexpr ',' term
                        { $$ = append_elem(OP_LIST, $1, $3); }
-       |       term
+       |       term %prec PREC_LOW
        ;
 
 listop :       LSTOP indirob argexpr
@@ -341,6 +358,10 @@ listop     :       LSTOP indirob argexpr
                                append_elem(OP_LIST,
                                    prepend_elem(OP_LIST, scalar($1), $5),
                                    newUNOP(OP_METHOD, 0, $3))); }
+       |       term ARROW method
+                       { $$ = convert(OP_ENTERSUB, OPf_STACKED,
+                               append_elem(OP_LIST, scalar($1),
+                                   newUNOP(OP_METHOD, 0, $3))); }
        |       METHOD indirob listexpr
                        { $$ = convert(OP_ENTERSUB, OPf_STACKED,
                                append_elem(OP_LIST,
@@ -367,6 +388,49 @@ method     :       METHOD
        |       scalar
        ;
 
+subscripted:    star '{' expr ';' '}'
+                       { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); }
+       |       scalar '[' expr ']'
+                       { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
+       |       term ARROW '[' expr ']'
+                       { $$ = newBINOP(OP_AELEM, 0,
+                                       ref(newAVREF($1),OP_RV2AV),
+                                       scalar($4));}
+       |       subscripted '[' expr ']'
+                       { $$ = newBINOP(OP_AELEM, 0,
+                                       ref(newAVREF($1),OP_RV2AV),
+                                       scalar($3));}
+       |       scalar '{' expr ';' '}'
+                       { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
+                           PL_expect = XOPERATOR; }
+       |       term ARROW '{' expr ';' '}'
+                       { $$ = newBINOP(OP_HELEM, 0,
+                                       ref(newHVREF($1),OP_RV2HV),
+                                       jmaybe($4));
+                           PL_expect = XOPERATOR; }
+       |       subscripted '{' expr ';' '}'
+                       { $$ = newBINOP(OP_HELEM, 0,
+                                       ref(newHVREF($1),OP_RV2HV),
+                                       jmaybe($3));
+                           PL_expect = XOPERATOR; }
+       |       term ARROW '(' ')'
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  newCVREF(0, scalar($1))); }
+       |       term ARROW '(' expr ')'
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  append_elem(OP_LIST, $4,
+                                      newCVREF(0, scalar($1)))); }
+
+       |       subscripted '(' expr ')'
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  append_elem(OP_LIST, $3,
+                                              newCVREF(0, scalar($1)))); }
+       |       subscripted '(' ')'
+                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+                                  newCVREF(0, scalar($1))); }
+
+
+
 term   :       term ASSIGNOP term
                        { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); }
        |       term POWOP term
@@ -426,9 +490,9 @@ term        :       term ASSIGNOP term
                        { $$ = sawparens($2); }
        |       '(' ')'
                        { $$ = sawparens(newNULLLIST()); }
-       |       '[' expr ']'                            %prec '('
+       |       '[' expr ']'
                        { $$ = newANONLIST($2); }
-       |       '[' ']'                                 %prec '('
+       |       '[' ']'
                        { $$ = newANONLIST(Nullop); }
        |       HASHBRACK expr ';' '}'                  %prec '('
                        { $$ = newANONHASH($2); }
@@ -438,56 +502,33 @@ term      :       term ASSIGNOP term
                        { $$ = newANONSUB($2, $3, $4); }
        |       scalar  %prec '('
                        { $$ = $1; }
-       |       star '{' expr ';' '}'
-                       { $$ = newBINOP(OP_GELEM, 0, newGVREF(0,$1), $3); }
        |       star    %prec '('
                        { $$ = $1; }
-       |       scalar '[' expr ']'     %prec '('
-                       { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); }
-       |       term ARROW '[' expr ']' %prec '('
-                       { $$ = newBINOP(OP_AELEM, 0,
-                                       ref(newAVREF($1),OP_RV2AV),
-                                       scalar($4));}
-       |       term '[' expr ']'       %prec '('
-                       { assertref($1); $$ = newBINOP(OP_AELEM, 0,
-                                       ref(newAVREF($1),OP_RV2AV),
-                                       scalar($3));}
        |       hsh     %prec '('
                        { $$ = $1; }
        |       ary     %prec '('
                        { $$ = $1; }
        |       arylen  %prec '('
                        { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
-       |       scalar '{' expr ';' '}' %prec '('
-                       { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3));
-                           expect = XOPERATOR; }
-       |       term ARROW '{' expr ';' '}'     %prec '('
-                       { $$ = newBINOP(OP_HELEM, 0,
-                                       ref(newHVREF($1),OP_RV2HV),
-                                       jmaybe($4));
-                           expect = XOPERATOR; }
-       |       term '{' expr ';' '}'   %prec '('
-                       { assertref($1); $$ = newBINOP(OP_HELEM, 0,
-                                       ref(newHVREF($1),OP_RV2HV),
-                                       jmaybe($3));
-                           expect = XOPERATOR; }
-       |       '(' expr ')' '[' expr ']'       %prec '('
+       |       subscripted
+                       { $$ = $1; }
+       |       '(' expr ')' '[' expr ']'
                        { $$ = newSLICEOP(0, $5, $2); }
-       |       '(' ')' '[' expr ']'    %prec '('
+       |       '(' ')' '[' expr ']'
                        { $$ = newSLICEOP(0, $4, Nullop); }
-       |       ary '[' expr ']'        %prec '('
+       |       ary '[' expr ']'
                        { $$ = prepend_elem(OP_ASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_ASLICE, 0,
                                        list($3),
                                        ref($1, OP_ASLICE))); }
-       |       ary '{' expr ';' '}'    %prec '('
+       |       ary '{' expr ';' '}'
                        { $$ = prepend_elem(OP_HSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_HSLICE, 0,
                                        list($3),
                                        ref(oopsHV($1), OP_HSLICE)));
-                           expect = XOPERATOR; }
+                           PL_expect = XOPERATOR; }
        |       THING   %prec '('
                        { $$ = $1; }
        |       amper
@@ -501,7 +542,7 @@ term        :       term ASSIGNOP term
                        { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            append_elem(OP_LIST, $3, scalar($2))); }
        |       DO term %prec UNIOP
-                       { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); }
+                       { $$ = dofile($2); }
        |       DO block        %prec '('
                        { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
        |       DO WORD '(' ')'
@@ -530,16 +571,9 @@ term       :       term ASSIGNOP term
                            prepend_elem(OP_LIST,
                                $4,
                                scalar(newCVREF(0,scalar($2))))); dep();}
-       |       term ARROW '(' ')'      %prec '('
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                                  newCVREF(0, scalar($1))); }
-       |       term ARROW '(' expr ')' %prec '('
-                       { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-                                  append_elem(OP_LIST, $4,
-                                      newCVREF(0, scalar($1)))); }
        |       LOOPEX
                        { $$ = newOP($1, OPf_SPECIAL);
-                           hints |= HINT_BLOCK_SCOPE; }
+                           PL_hints |= HINT_BLOCK_SCOPE; }
        |       LOOPEX term
                        { $$ = newLOOPEX($1,$2); }
        |       NOTOP argexpr
@@ -572,9 +606,9 @@ term        :       term ASSIGNOP term
        |       listop
        ;
 
-listexpr:      /* NULL */
+listexpr:      /* NULL */ %prec PREC_LOW
                        { $$ = Nullop; }
-       |       argexpr
+       |       argexpr    %prec PREC_LOW
                        { $$ = $1; }
        ;
 
@@ -591,7 +625,7 @@ local       :       LOCAL   { $$ = 0; }
        ;
 
 my_scalar:     scalar
-                       { in_my = 0; $$ = my($1); }
+                       { PL_in_my = 0; $$ = my($1); }
        ;
 
 amper  :       '&' indirob
@@ -620,7 +654,7 @@ star        :       '*' indirob
 
 indirob        :       WORD
                        { $$ = scalar($1); }
-       |       scalar
+       |       scalar %prec PREC_LOW
                        { $$ = scalar($1);  }
        |       block
                        { $$ = scope($1); }