X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=a30f4cea7ecda0e2c6446bf27c70eefc99bacdae;hb=218659229ea7e7f2d98c1a7697e6218c585dfb37;hp=9df012c3aaa199611337f6e088a0e7805d724173;hpb=fad39ff13c300fe483c6155ea2883280e12fc89c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perly.y b/perly.y index 9df012c..a30f4ce 100644 --- a/perly.y +++ b/perly.y @@ -1,6 +1,6 @@ /* perly.y * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-2001, 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. @@ -16,16 +16,39 @@ #include "EXTERN.h" #define PERL_IN_PERLY_C #include "perl.h" - +#ifdef EBCDIC +#undef YYDEBUG +#endif #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 +59,13 @@ } %{ -#endif /* !OEMVS && !__OPEN_VM && !POSIX_BC */ +#endif /* 0 */ #ifdef USE_PURE_BISON #define YYLEX_PARAM (&yychar) +#define yylex yylex_r #endif + %} %token '{' @@ -54,15 +79,17 @@ %token FUNC0 FUNC1 FUNC UNIOP LSTOP %token RELOP EQOP MULOP ADDOP %token DOLSHARP DO HASHBRACK NOAMP -%token LOCAL MY +%token LOCAL MY MYSUB +%token COLONATTR -%type prog decl local format startsub startanonsub startformsub +%type prog decl format startsub startanonsub startformsub %type remember mremember '&' %type block mblock lineseq line loop cond else %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 subattrlist myattrlist mysubrout myattrterm myterm %type label %nonassoc PREC_LOW @@ -100,7 +127,7 @@ prog : /* NULL */ { #if defined(YYDEBUG) && defined(DEBUGGING) - yydebug = (PL_debug & 1); + yydebug = (DEBUG_p_TEST); #endif PL_expect = XSTATE; } @@ -176,7 +203,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); @@ -223,13 +250,20 @@ 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 */ - { OP *forop = append_elem(OP_LINESEQ, - scalar($5), - newWHILEOP(0, 1, (LOOP*)Nullop, - $2, scalar($7), - $11, scalar($9))); + { OP *forop; PL_copline = $2; - $$ = block_end($4, newSTATEOP(0, $1, forop)); } + forop = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, scalar($7), + $11, $9)); + if ($5) { + forop = append_elem(OP_LINESEQ, + newSTATEOP(0, ($1?savepv($1):Nullch), + $5), + forop); + } + + $$ = block_end($4, forop); } | label block cont /* a block is a loop that happens once */ { $$ = newSTATEOP(0, $1, newWHILEOP(0, 1, (LOOP*)Nullop, @@ -242,7 +276,7 @@ nexpr : /* NULL */ ; texpr : /* NULL means true */ - { (void)scan_num("1"); $$ = yylval.opval; } + { (void)scan_num("1", &yylval); $$ = yylval.opval; } | expr ; @@ -275,6 +309,8 @@ decl : format { $$ = 0; } | subrout { $$ = 0; } + | mysubrout + { $$ = 0; } | package { $$ = 0; } | use @@ -289,8 +325,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 +347,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 +357,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 +431,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 +538,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 +554,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 +662,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 +694,6 @@ listexprcom: /* NULL */ { $$ = $1; } ; -local : LOCAL { $$ = 0; } - | MY { $$ = 1; } - ; - my_scalar: scalar { PL_in_my = 0; $$ = my($1); } ; @@ -664,3 +734,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) +