X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=599652733107d169978ba0681b1cad4ee2d250e1;hb=b851de6cd1cc79b5e8ed7db02ebd0a9769d34232;hp=5ee78f8210d722da0e74736bc476f67f0a1baff0;hpb=5f05dabc4054964aa3b10f44f8468547f051cdf8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.y b/perly.y index 5ee78f8..5996527 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,7 +9,7 @@ /* * '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.' */ %{ @@ -46,12 +46,13 @@ dep() %token DOLSHARP DO HASHBRACK NOAMP %token LOCAL MY -%type prog decl local format startsub remember mremember '&' +%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 argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr -%type listexpr listexprcom indirob -%type listop method proto cont my_scalar +%type listexpr listexprcom indirob listop method +%type formname subname proto subbody cont my_scalar %type label %left OROP @@ -173,15 +174,6 @@ cond : IF '(' remember mexpr ')' mblock else { copline = $1; $$ = block_end($3, newCONDOP(0, $4, scope($6), $7)); } - | IF block block else - { copline = $1; - deprecate("if BLOCK BLOCK"); - $$ = newCONDOP(0, scope($2), scope($3), $4); } - | UNLESS block block else - { copline = $1; - deprecate("unless BLOCK BLOCK"); - $$ = newCONDOP(0, invert(scalar(scope($2))), - scope($3), $4); } ; cont : /* NULL */ @@ -202,19 +194,6 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, $5, $7, $8))); } - | label WHILE block block cont - { copline = $2; - deprecate("while BLOCK BLOCK"); - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - scope($3), $4, $5)); } - | label UNTIL block block cont - { copline = $2; - deprecate("until BLOCK BLOCK"); - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope($3))), - $4, $5)); } | label FOR MY remember my_scalar '(' mexpr ')' mblock cont { $$ = block_end($4, newFOROP(0, $1, $2, $5, $7, $9, $10)); } @@ -229,8 +208,8 @@ loop : label WHILE '(' remember mtexpr ')' mblock cont /* basically fake up an initialize-while lineseq */ { copline = $2; $$ = block_end($4, - append_elem(OP_LINESEQ, scalar($5), - newSTATEOP(0, $1, + newSTATEOP(0, $1, + append_elem(OP_LINESEQ, scalar($5), newWHILEOP(0, 1, (LOOP*)Nullop, scalar($7), $11, scalar($9))))); } @@ -285,25 +264,44 @@ decl : format { $$ = 0; } ; -format : FORMAT startsub WORD block +format : FORMAT startformsub formname block { newFORM($2, $3, $4); } - | FORMAT startsub block - { newFORM($2, Nullop, $3); } ; -subrout : SUB startsub WORD proto block +formname: WORD { $$ = $1; } + | /* NULL */ { $$ = Nullop; } + ; + +subrout : SUB startsub subname proto subbody { newSUB($2, $3, $4, $5); } - | SUB startsub WORD proto ';' - { newSUB($2, $3, $4, Nullop); expect = XSTATE; } + ; + +startsub: /* NULL */ /* start a regular subroutine scope */ + { $$ = start_subparse(FALSE, 0); } + ; + +startanonsub: /* NULL */ /* start an anonymous subroutine scope */ + { $$ = start_subparse(FALSE, CVf_ANON); } + ; + +startformsub: /* NULL */ /* start a format subroutine scope */ + { $$ = start_subparse(TRUE, 0); } + ; + +subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, na); + if (strEQ(name, "BEGIN") || strEQ(name, "END") + || strEQ(name, "INIT")) + CvUNIQUE_on(compcv); + $$ = $1; } ; proto : /* NULL */ { $$ = Nullop; } | THING ; - -startsub: /* NULL */ /* start a subroutine scope */ - { $$ = start_subparse(); } + +subbody : block { $$ = $1; } + | ';' { $$ = Nullop; expect = XSTATE; } ; package : PACKAGE WORD ';' @@ -312,8 +310,10 @@ package : PACKAGE WORD ';' { package(Nullop); } ; -use : USE startsub WORD WORD listexpr ';' - { utilize($1, $2, $3, $4, $5); } +use : USE startsub + { CvUNIQUE_on(compcv); /* It's a BEGIN {} */ } + WORD WORD listexpr ';' + { utilize($1, $2, $4, $5, $6); } ; expr : expr ANDOP expr @@ -355,11 +355,12 @@ listop : LSTOP indirob argexpr { $$ = convert($1, 0, $2); } | FUNC '(' listexprcom ')' { $$ = convert($1, 0, $3); } - | LSTOPSUB startsub block listexpr %prec LSTOP + | LSTOPSUB startanonsub block + { $3 = newANONSUB($2, 0, $3); } + listexpr %prec LSTOP { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - append_elem(OP_LIST, - prepend_elem(OP_LIST, newANONSUB($2, 0, $3), $4), - $1)); } + append_elem(OP_LIST, + prepend_elem(OP_LIST, $3, $5), $1)); } ; method : METHOD @@ -433,7 +434,7 @@ term : term ASSIGNOP term { $$ = newANONHASH($2); } | HASHBRACK ';' '}' %prec '(' { $$ = newANONHASH(Nullop); } - | ANONSUB startsub proto block %prec '(' + | ANONSUB startanonsub proto block %prec '(' { $$ = newANONSUB($2, $3, $4); } | scalar %prec '(' { $$ = $1; } @@ -529,6 +530,13 @@ 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; } @@ -550,7 +558,7 @@ term : term ASSIGNOP term | FUNC0 '(' ')' { $$ = newOP($1, 0); } | FUNC0SUB - { $$ = newUNOP(OP_ENTERSUB, 0, + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); } | FUNC1 '(' ')' { $$ = newOP($1, OPf_SPECIAL); }