X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=x2p%2Fa2p.y;h=74c42d8c199d5ca145661f49bc04cc094c0b6591;hb=d9f30342f9de4793189d81b85a5e32057393e428;hp=6a6604d5010d5105c94f877eb557c5751a45d56d;hpb=449aadcac0f13893f2b716ea169bf74293ee9c41;p=p5sagit%2Fp5-mst-13.2.git diff --git a/x2p/a2p.y b/x2p/a2p.y index 6a6604d..74c42d8 100644 --- a/x2p/a2p.y +++ b/x2p/a2p.y @@ -1,18 +1,13 @@ %{ -/* $Header: a2p.y,v 3.0.1.1 90/03/01 10:30:08 lwall Locked $ +/* $RCSfile: a2p.y,v $$Revision: 4.1 $$Date: 92/08/07 18:29:12 $ * - * Copyright (c) 1989, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1996, 1997, 1999, 2000, + * by Larry Wall and others * - * You may distribute under the terms of the GNU General Public License - * as specified in the README file that comes with the perl 3.0 kit. + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. * * $Log: a2p.y,v $ - * Revision 3.0.1.1 90/03/01 10:30:08 lwall - * patch9: a2p didn't allow logical expressions everywhere it should - * - * Revision 3.0 89/10/18 15:34:29 lwall - * 3.0 baseline - * */ #include "INTERN.h" @@ -27,7 +22,7 @@ int ends = Nullop; %token REGEX %token SEMINEW NEWLINE COMMENT %token FUN1 FUNN GRGR -%token PRINT PRINTF SPRINTF SPLIT +%token PRINT PRINTF SPRINTF_OLD SPRINTF_NEW SPLIT %token IF ELSE WHILE FOR IN %token EXIT NEXT BREAK CONTINUE RET %token GETLINE DO SUB GSUB MATCH @@ -49,7 +44,7 @@ int ends = Nullop; %left NOT %right '^' %left INCR DECR -%left FIELD VFIELD +%left FIELD VFIELD SVFIELD %% @@ -100,6 +95,8 @@ cond : expr | match | rel | compound_cond + | cond '?' expr ':' expr + { $$ = oper3(OCOND,$1,$3,$5); } ; compound_cond @@ -137,15 +134,21 @@ expr : term { $$ = $1; } | expr term { $$ = oper2(OCONCAT,$1,$2); } - | variable ASGNOP expr - { $$ = oper3(OASSIGN,$2,$1,$3); - if ((ops[$1].ival & 255) == OFLD) - lval_field = TRUE; - if ((ops[$1].ival & 255) == OVFLD) - lval_field = TRUE; + | expr '?' expr ':' expr + { $$ = oper3(OCOND,$1,$3,$5); } + | variable ASGNOP cond + { + $$ = oper3(OASSIGN,$2,$1,$3); + if ((ops[$1].ival & 255) == OFLD) + lval_field = TRUE; + else if ((ops[$1].ival & 255) == OVFLD) + lval_field = TRUE; } ; +sprintf : SPRINTF_NEW + | SPRINTF_OLD ; + term : variable { $$ = $1; } | NUMBER @@ -166,16 +169,38 @@ term : variable { $$ = oper2(OPOW,$1,$3); } | term IN VAR { $$ = oper2(ODEFINED,aryrefarg($3),$1); } - | term '?' term ':' term - { $$ = oper2(OCOND,$1,$3,$5); } | variable INCR - { $$ = oper1(OPOSTINCR,$1); } + { + $$ = oper1(OPOSTINCR,$1); + if ((ops[$1].ival & 255) == OFLD) + lval_field = TRUE; + else if ((ops[$1].ival & 255) == OVFLD) + lval_field = TRUE; + } | variable DECR - { $$ = oper1(OPOSTDECR,$1); } + { + $$ = oper1(OPOSTDECR,$1); + if ((ops[$1].ival & 255) == OFLD) + lval_field = TRUE; + else if ((ops[$1].ival & 255) == OVFLD) + lval_field = TRUE; + } | INCR variable - { $$ = oper1(OPREINCR,$2); } + { + $$ = oper1(OPREINCR,$2); + if ((ops[$2].ival & 255) == OFLD) + lval_field = TRUE; + else if ((ops[$2].ival & 255) == OVFLD) + lval_field = TRUE; + } | DECR variable - { $$ = oper1(OPREDECR,$2); } + { + $$ = oper1(OPREDECR,$2); + if ((ops[$2].ival & 255) == OFLD) + lval_field = TRUE; + else if ((ops[$2].ival & 255) == OVFLD) + lval_field = TRUE; + } | '-' term %prec UMINUS { $$ = oper1(OUMINUS,$2); } | '+' term %prec UMINUS @@ -184,18 +209,18 @@ term : variable { $$ = oper1(OPAREN,$2); } | GETLINE { $$ = oper0(OGETLINE); } - | GETLINE VAR + | GETLINE variable { $$ = oper1(OGETLINE,$2); } | GETLINE '<' expr { $$ = oper3(OGETLINE,Nullop,string("<",1),$3); if (ops[$3].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } - | GETLINE VAR '<' expr + | GETLINE variable '<' expr { $$ = oper3(OGETLINE,$2,string("<",1),$4); if (ops[$4].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } | term 'p' GETLINE { $$ = oper3(OGETLINE,Nullop,string("|",1),$1); if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } - | term 'p' GETLINE VAR + | term 'p' GETLINE variable { $$ = oper3(OGETLINE,$4,string("|",1),$1); if (ops[$1].ival != OSTR + (1<<8)) do_fancy_opens = TRUE; } | FUN1 @@ -208,7 +233,9 @@ term : variable { $$ = oper1($1,$3); } | USERFUN '(' expr_list ')' { $$ = oper2(OUSERFUN,$1,$3); } - | SPRINTF expr_list + | SPRINTF_NEW '(' expr_list ')' + { $$ = oper1(OSPRINTF,$3); } + | sprintf expr_list { $$ = oper1(OSPRINTF,$2); } | SUBSTR '(' expr ',' expr ',' expr ')' { $$ = oper3(OSUBSTR,$3,$5,$7); } @@ -216,6 +243,8 @@ term : variable { $$ = oper2(OSUBSTR,$3,$5); } | SPLIT '(' expr ',' VAR ',' expr ')' { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),$7); } + | SPLIT '(' expr ',' VAR ',' REGEX ')' + { $$ = oper3(OSPLIT,$3,aryrefarg(numary($5)),oper1(OREGEX,$7));} | SPLIT '(' expr ',' VAR ')' { $$ = oper2(OSPLIT,$3,aryrefarg(numary($5))); } | INDEX '(' expr ',' expr ')' @@ -248,6 +277,8 @@ variable: VAR { $$ = oper2(OVAR,aryrefarg($1),$3); } | FIELD { $$ = oper1(OFLD,$1); } + | SVFIELD + { $$ = oper1(OVFLD,oper1(OVAR,$1)); } | VFIELD term { $$ = oper1(OVFLD,$2); } ; @@ -363,12 +394,12 @@ simple { $$ = oper0(ORETURN); } | RET expr { $$ = oper1(ORETURN,$2); } - | DELETE VAR '[' expr ']' + | DELETE VAR '[' expr_list ']' { $$ = oper2(ODELETE,aryrefarg($2),$4); } ; redir : '>' %prec FIELD - { $$ = oper1(OREDIR,$1); } + { $$ = oper1(OREDIR,string(">",1)); } | GRGR { $$ = oper1(OREDIR,string(">>",2)); } | '|' @@ -395,4 +426,7 @@ compound ; %% + +int yyparse (void); + #include "a2py.c"