X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=9df012c3aaa199611337f6e088a0e7805d724173;hb=82839a9d866c50672322b6c8ebe25182b233dcd3;hp=5de74ff650e34e9e4f1aa25f98dd0ce37d03e635;hpb=774d564bb7dd1ed64ca0d7e534aa67e93f991f02;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.y b/perly.y index 5de74ff..9df012c 100644 --- a/perly.y +++ b/perly.y @@ -1,6 +1,6 @@ /* perly.y * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, 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. @@ -9,23 +9,25 @@ /* * 'I see,' laughed Strider. 'I look foul and feel fair. Is that it? - * All that is gold does not glitter, not all those that wander are lost.' + * All that is gold does not glitter, not all those who wander are lost.' */ %{ #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 '{' ')' +%{ +#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */ + +#ifdef USE_PURE_BISON +#define YYLEX_PARAM (&yychar) +#endif +%} + +%token '{' %token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF %token FUNC0SUB UNIOPSUB LSTOPSUB @@ -49,12 +59,15 @@ dep() %type prog decl local format startsub startanonsub startformsub %type remember mremember '&' %type block mblock lineseq line loop cond else -%type expr term scalar ary hsh arylen star amper sideff +%type expr term subscripted scalar ary hsh arylen star amper sideff %type argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr %type listexpr listexprcom indirob listop method %type formname subname proto subbody cont my_scalar %type label +%nonassoc PREC_LOW +%nonassoc LOOPEX + %left OROP %left ANDOP %right NOTOP @@ -78,24 +91,26 @@ dep() %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC %left ARROW +%nonassoc ')' %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,17 +200,17 @@ 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, - $5, $7, $8))); } + $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, - $5, $7, $8))); } + $2, $5, $7, $8))); } | label FOR MY remember my_scalar '(' mexpr ')' mblock cont { $$ = block_end($4, newFOROP(0, $1, $2, $5, $7, $9, $10)); } @@ -206,17 +223,17 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont newFOROP(0, $1, $2, Nullop, $5, $7, $8)); } | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock /* basically fake up an initialize-while lineseq */ - { copline = $2; - $$ = block_end($4, - append_elem(OP_LINESEQ, scalar($5), - newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - scalar($7), - $11, scalar($9))))); } + { OP *forop = append_elem(OP_LINESEQ, + scalar($5), + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, scalar($7), + $11, scalar($9))); + PL_copline = $2; + $$ = block_end($4, newSTATEOP(0, $1, forop)); } | label block cont /* a block is a loop that happens once */ - { $$ = newSTATEOP(0, - $1, newWHILEOP(0, 1, (LOOP*)Nullop, - Nullop, $2, $3)); } + { $$ = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + NOLINE, Nullop, $2, $3)); } ; nexpr : /* NULL */ @@ -288,9 +305,10 @@ startformsub: /* NULL */ /* start a format subroutine scope */ { $$ = start_subparse(TRUE, 0); } ; -subname : WORD { char *name = SvPVx(((SVOP*)$1)->op_sv, na); - if (strEQ(name, "BEGIN") || strEQ(name, "END")) - CvUNIQUE_on(compcv); +subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a); + if (strEQ(name, "BEGIN") || strEQ(name, "END") + || strEQ(name, "INIT")) + CvSPECIAL_on(PL_compcv); $$ = $1; } ; @@ -300,7 +318,7 @@ proto : /* NULL */ ; subbody : block { $$ = $1; } - | ';' { $$ = Nullop; expect = XSTATE; } + | ';' { $$ = Nullop; PL_expect = XSTATE; } ; package : PACKAGE WORD ';' @@ -310,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); } ; @@ -319,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 @@ -340,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, @@ -366,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 @@ -425,9 +490,9 @@ term : term ASSIGNOP term { $$ = sawparens($2); } | '(' ')' { $$ = sawparens(newNULLLIST()); } - | '[' expr ']' %prec '(' + | '[' expr ']' { $$ = newANONLIST($2); } - | '[' ']' %prec '(' + | '[' ']' { $$ = newANONLIST(Nullop); } | HASHBRACK expr ';' '}' %prec '(' { $$ = newANONHASH($2); } @@ -437,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 @@ -500,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 '(' ')' @@ -531,7 +573,7 @@ term : term ASSIGNOP term scalar(newCVREF(0,scalar($2))))); dep();} | LOOPEX { $$ = newOP($1, OPf_SPECIAL); - hints |= HINT_BLOCK_SCOPE; } + PL_hints |= HINT_BLOCK_SCOPE; } | LOOPEX term { $$ = newLOOPEX($1,$2); } | NOTOP argexpr @@ -564,9 +606,9 @@ term : term ASSIGNOP term | listop ; -listexpr: /* NULL */ +listexpr: /* NULL */ %prec PREC_LOW { $$ = Nullop; } - | argexpr + | argexpr %prec PREC_LOW { $$ = $1; } ; @@ -583,7 +625,7 @@ local : LOCAL { $$ = 0; } ; my_scalar: scalar - { in_my = 0; $$ = my($1); } + { PL_in_my = 0; $$ = my($1); } ; amper : '&' indirob @@ -612,7 +654,7 @@ star : '*' indirob indirob : WORD { $$ = scalar($1); } - | scalar + | scalar %prec PREC_LOW { $$ = scalar($1); } | block { $$ = scope($1); }