X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/85e6fe838fb25b257a1b363debf8691c0992ef71..084b8eeb79bb97cd6a1b051bc9b7db2007cf036f:/perly.y diff --git a/perly.y b/perly.y index 691d668..7d39242 100644 --- a/perly.y +++ b/perly.y @@ -1,52 +1,56 @@ -/* $RCSfile: perly.y,v $$Revision: 4.1 $$Date: 92/08/07 18:26:16 $ +/* perly.y * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-2002, 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. * - * $Log: perly.y,v $ - * Revision 4.1 92/08/07 18:26:16 lwall - * - * Revision 4.0.1.5 92/06/11 21:12:50 lwall - * patch34: expectterm incorrectly set to indicate start of program or block - * - * Revision 4.0.1.4 92/06/08 17:33:25 lwall - * patch20: one of the backdoors to expectterm was on the wrong reduction - * - * Revision 4.0.1.3 92/06/08 15:18:16 lwall - * patch20: an expression may now start with a bareword - * patch20: relaxed requirement for semicolon at the end of a block - * patch20: added ... as variant on .. - * patch20: fixed double debug break in foreach with implicit array assignment - * patch20: if {block} {block} didn't work any more - * patch20: deleted some minor memory leaks - * - * Revision 4.0.1.2 91/11/05 18:17:38 lwall - * patch11: extra comma at end of list is now allowed in more places (Hi, Felix!) - * patch11: once-thru blocks didn't display right in the debugger - * patch11: debugger got confused over nested subroutine definitions - * - * Revision 4.0.1.1 91/06/07 11:42:34 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:38:40 lwall - * 4.0 baseline. - * + */ + +/* + * 'I see,' laughed Strider. 'I look foul and feel fair. Is that it? + * 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" - -/*SUPPRESS 530*/ -/*SUPPRESS 593*/ -/*SUPPRESS 595*/ +#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(pTHX_ void *ptr); %} %start prog +%{ +#if 0 /* get this from perly.h instead */ +%} + %union { I32 ival; char *pval; @@ -54,39 +58,59 @@ GV *gvval; } -%token '{' ')' +%{ +#endif /* 0 */ + +#ifdef USE_PURE_BISON +#define YYLEX_PARAM (&yychar) +#define yylex yylex_r +#endif + +%} + +%token '{' -%token WORD METHOD THING PMFUNC PRIVATEREF +%token WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF +%token FUNC0SUB UNIOPSUB LSTOPSUB %token LABEL -%token FORMAT SUB PACKAGE HINT +%token FORMAT SUB ANONSUB PACKAGE USE %token WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR %token LOOPEX DOTDOT -%token FUNC0 FUNC1 FUNC +%token FUNC0 FUNC1 FUNC UNIOP LSTOP %token RELOP EQOP MULOP ADDOP -%token DOLSHARP DO LOCAL DELETE HASHBRACK NOAMP - -%type prog decl format remember crp crb crhb -%type block lineseq line loop cond nexpr else -%type expr sexpr term scalar ary hsh arylen star amper sideff -%type listexpr indirob -%type texpr listop +%token DOLSHARP DO HASHBRACK NOAMP +%token LOCAL MY MYSUB +%token COLONATTR + +%type prog decl format startsub startanonsub startformsub +%type progstart 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 termbinop termunop anonymous termdo %type label -%type cont -%left OROP +%nonassoc PREC_LOW +%nonassoc LOOPEX + +%left OROP DOROP %left ANDOP -%nonassoc LSTOP +%right NOTOP +%nonassoc LSTOP LSTOPSUB %left ',' -%right '=' +%right ASSIGNOP %right '?' ':' %nonassoc DOTDOT -%left OROR +%left OROR DORDOR %left ANDAND %left BITOROP %left BITANDOP %nonassoc EQOP %nonassoc RELOP -%nonassoc UNIOP +%nonassoc UNIOP UNIOPSUB %left SHIFTOP %left ADDOP %left MULOP @@ -95,61 +119,62 @@ %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC %left ARROW +%nonassoc ')' %left '(' +%left '[' '{' %% /* RULES */ -prog : /* NULL */ +/* The whole program */ +prog : progstart + /*CONTINUED*/ lineseq + { $$ = $1; newPROG(block_end($1,$2)); } + ; + +/* An ordinary block */ +block : '{' remember lineseq '}' + { if (PL_copline > (line_t)$1) + PL_copline = (line_t)$1; + $$ = block_end($2, $3); } + ; + +remember: /* NULL */ /* start a full lexical scope */ + { $$ = block_start(TRUE); } + ; + +progstart: { #if defined(YYDEBUG) && defined(DEBUGGING) - yydebug = (debug & 1); + yydebug = (DEBUG_p_TEST); #endif - expect = XSTATE; + PL_expect = XSTATE; $$ = block_start(TRUE); } - /*CONTINUED*/ lineseq - { if (in_eval) { - eval_root = newUNOP(OP_LEAVEEVAL, 0, $2); - eval_start = linklist(eval_root); - eval_root->op_next = 0; - peep(eval_start); - } - else - main_root = block_head($2, &main_start); - } ; -block : '{' remember lineseq '}' - { int needblockscope = hints & HINT_BLOCK_SCOPE; - $$ = scalarseq($3); - if (copline > (line_t)$1) - copline = $1; - LEAVE_SCOPE($2); - if (needblockscope) - hints |= HINT_BLOCK_SCOPE; /* propagate out */ - pad_leavemy(comppad_name_fill); } - ; - -remember: /* NULL */ /* in case they push a package name */ - { $$ = savestack_ix; - comppad_name_fill = AvFILL(comppad_name); - SAVEINT(min_intro_pending); - SAVEINT(max_intro_pending); - min_intro_pending = 0; - SAVEINT(comppad_name_fill); - SAVEINT(hints); - hints &= ~HINT_BLOCK_SCOPE; } + +mblock : '{' mremember lineseq '}' + { if (PL_copline > (line_t)$1) + PL_copline = (line_t)$1; + $$ = block_end($2, $3); } ; +mremember: /* NULL */ /* start a partial lexical scope */ + { $$ = block_start(FALSE); } + ; + +/* A collection of "lines" in the program */ lineseq : /* NULL */ { $$ = Nullop; } | lineseq decl { $$ = $1; } | lineseq line { $$ = append_list(OP_LINESEQ, - (LISTOP*)$1, (LISTOP*)$2); pad_reset(); - if ($1 && $2) hints |= HINT_BLOCK_SCOPE; } + (LISTOP*)$1, (LISTOP*)$2); + PL_pad_reset_pending = TRUE; + if ($1 && $2) PL_hints |= HINT_BLOCK_SCOPE; } ; +/* A "line" in the program */ line : label cond { $$ = newSTATEOP(0, $1, $2); } | loop /* loops add their own labels */ @@ -159,14 +184,15 @@ 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; } ; +/* An expression which may have a side-effect */ sideff : error { $$ = Nullop; } | expr @@ -177,396 +203,561 @@ sideff : error { $$ = newLOGOP(OP_OR, 0, $3, $1); } | expr WHILE expr { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); } - | expr UNTIL expr - { $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);} + | expr UNTIL iexpr + { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);} + | expr FOR expr + { $$ = newFOROP(0, Nullch, (line_t)$2, + Nullop, $3, $1, Nullop); } ; +/* else and elsif blocks */ else : /* NULL */ { $$ = Nullop; } - | ELSE block - { $$ = scope($2); } - | ELSIF '(' expr ')' block else - { copline = $1; - $$ = newSTATEOP(0, 0, - newCONDOP(0, $3, scope($5), $6)); } - ; - -cond : IF '(' expr ')' block else - { copline = $1; - $$ = newCONDOP(0, $3, scope($5), $6); } - | UNLESS '(' expr ')' block else - { copline = $1; - $$ = newCONDOP(0, - invert(scalar($3)), scope($5), $6); } - | IF block block else - { copline = $1; - $$ = newCONDOP(0, scope($2), scope($3), $4); } - | UNLESS block block else - { copline = $1; - $$ = newCONDOP(0, invert(scalar(scope($2))), - scope($3), $4); } - ; - + | ELSE mblock + { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); } + | ELSIF '(' mexpr ')' mblock else + { PL_copline = (line_t)$1; + $$ = newCONDOP(0, $3, scope($5), $6); + PL_hints |= HINT_BLOCK_SCOPE; } + ; + +/* Real conditional expressions */ +cond : IF '(' remember mexpr ')' mblock else + { PL_copline = (line_t)$1; + $$ = block_end($3, + newCONDOP(0, $4, scope($6), $7)); } + | UNLESS '(' remember miexpr ')' mblock else + { PL_copline = (line_t)$1; + $$ = block_end($3, + newCONDOP(0, $4, scope($6), $7)); } + ; + +/* Continue blocks */ cont : /* NULL */ { $$ = Nullop; } | CONTINUE block { $$ = scope($2); } ; -loop : label WHILE '(' texpr ')' block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - $4, $6, $7) ); } - | label UNTIL '(' expr ')' block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar($4)), $6, $7) ); } - | label WHILE block block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - scope($3), $4, $5) ); } - | label UNTIL block block cont - { copline = $2; - $$ = newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - invert(scalar(scope($3))), $4, $5)); } - | label FOR scalar '(' expr crp block cont - { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP), - $5, $7, $8); } - | label FOR '(' expr crp block cont - { $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); } - | label FOR '(' nexpr ';' texpr ';' nexpr ')' block +/* Loops: while, until, for, and a bare block */ +loop : label WHILE '(' remember mtexpr ')' mblock cont + { PL_copline = (line_t)$2; + $$ = block_end($4, + newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, $5, $7, $8))); } + | label UNTIL '(' remember miexpr ')' mblock cont + { PL_copline = (line_t)$2; + $$ = block_end($4, + newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + $2, $5, $7, $8))); } + | label FOR MY remember my_scalar '(' mexpr ')' mblock cont + { $$ = block_end($4, + newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); } + | label FOR scalar '(' remember mexpr ')' mblock cont + { $$ = block_end($5, + newFOROP(0, $1, (line_t)$2, mod($3, OP_ENTERLOOP), + $6, $8, $9)); } + | label FOR '(' remember mexpr ')' mblock cont + { $$ = block_end($4, + newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); } + | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock /* basically fake up an initialize-while lineseq */ - { copline = $2; - $$ = append_elem(OP_LINESEQ, - newSTATEOP(0, $1, scalar($4)), - newSTATEOP(0, $1, - newWHILEOP(0, 1, (LOOP*)Nullop, - scalar($6), $10, scalar($8)) )); } + { OP *forop; + PL_copline = (line_t)$2; + 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, - Nullop, $2, $3)); } + { $$ = newSTATEOP(0, $1, + newWHILEOP(0, 1, (LOOP*)Nullop, + NOLINE, Nullop, $2, $3)); } ; +/* Normal expression */ nexpr : /* NULL */ { $$ = Nullop; } | sideff ; +/* Boolean expression */ texpr : /* NULL means true */ - { (void)scan_num("1"); $$ = yylval.opval; } + { (void)scan_num("1", &yylval); $$ = yylval.opval; } | expr ; +/* Inverted boolean expression */ +iexpr : expr + { $$ = invert(scalar($1)); } + ; + +/* Expression with its own lexical scope */ +mexpr : expr + { $$ = $1; intro_my(); } + ; + +mnexpr : nexpr + { $$ = $1; intro_my(); } + ; + +mtexpr : texpr + { $$ = $1; intro_my(); } + ; + +miexpr : iexpr + { $$ = $1; intro_my(); } + ; + +/* Optional "MAIN:"-style loop labels */ label : /* empty */ { $$ = Nullch; } | LABEL ; +/* Some kind of declaration - does not take part in the parse tree */ decl : format { $$ = 0; } | subrout { $$ = 0; } + | mysubrout + { $$ = 0; } | package { $$ = 0; } - | hint + | use { $$ = 0; } ; -format : FORMAT WORD block - { newFORM($1, $2, $3); } - | FORMAT block - { newFORM($1, Nullop, $2); } +format : FORMAT startformsub formname block + { newFORM($2, $3, $4); } + ; + +formname: WORD { $$ = $1; } + | /* NULL */ { $$ = Nullop; } + ; + +/* Unimplemented "my sub foo { }" */ +mysubrout: MYSUB startsub subname proto subattrlist subbody + { newMYSUB($2, $3, $4, $5, $6); } + ; + +/* Subroutine definition */ +subrout : SUB startsub subname proto subattrlist subbody + { newATTRSUB($2, $3, $4, $5, $6); } + ; + +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); } + ; + +/* Name of a subroutine - must be a bareword, could be special */ +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, "CHECK")) + CvSPECIAL_on(PL_compcv); + $$ = $1; } + ; + +/* Subroutine prototype */ +proto : /* NULL */ + { $$ = Nullop; } + | THING + ; + +/* Optional list of subroutine attributes */ +subattrlist: /* NULL */ + { $$ = Nullop; } + | COLONATTR THING + { $$ = $2; } + | COLONATTR + { $$ = Nullop; } + ; + +/* List of attributes for a "my" variable declaration */ +myattrlist: COLONATTR THING + { $$ = $2; } + | COLONATTR + { $$ = Nullop; } ; -subrout : SUB WORD block - { newSUB($1, $2, $3); } - | SUB WORD ';' - { newSUB($1, $2, Nullop); expect = XSTATE; } +/* Subroutine body - either null or a block */ +subbody : block { $$ = $1; } + | ';' { $$ = Nullop; PL_expect = XSTATE; } ; package : PACKAGE WORD ';' { package($2); } - | PACKAGE ';' - { package(Nullop); } ; -hint : HINT WORD ';' - { hint($1, $2, Nullop); } - | HINT WORD expr ';' - { hint($1, $2, list(force_list($3))); } +use : USE startsub + { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } + WORD WORD listexpr ';' + { utilize($1, $2, $4, $5, $6); } + ; + +/* Ordinary expressions; logical combinations */ +expr : expr ANDOP expr + { $$ = newLOGOP(OP_AND, 0, $1, $3); } + | expr OROP expr + { $$ = newLOGOP($2, 0, $1, $3); } + | expr DOROP expr + { $$ = newLOGOP(OP_DOR, 0, $1, $3); } + | argexpr %prec PREC_LOW ; -expr : expr ',' sexpr +/* Expressions are a list of terms joined by commas */ +argexpr : argexpr ',' + { $$ = $1; } + | argexpr ',' term { $$ = append_elem(OP_LIST, $1, $3); } - | sexpr + | term %prec PREC_LOW ; -listop : LSTOP indirob listexpr +/* List operators */ +listop : LSTOP indirob argexpr /* print $fh @args */ { $$ = convert($1, OPf_STACKED, - prepend_elem(OP_LIST, newGVREF($2), $3) ); } - | FUNC '(' indirob listexpr ')' + prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); } + | FUNC '(' indirob expr ')' /* print ($fh @args */ { $$ = convert($1, OPf_STACKED, - prepend_elem(OP_LIST, newGVREF($3), $4) ); } - | indirob ARROW LSTOP listexpr - { $$ = convert($3, OPf_STACKED, - prepend_elem(OP_LIST, newGVREF($1), $4) ); } - | indirob ARROW FUNC '(' listexpr ')' - { $$ = convert($3, OPf_STACKED, - prepend_elem(OP_LIST, newGVREF($1), $5) ); } - | term ARROW METHOD '(' listexpr ')' - { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, - newMETHOD($1,$3), list($5))); } - | METHOD indirob listexpr - { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, - newMETHOD($2,$1), list($3))); } - | LSTOP listexpr + prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); } + | term ARROW method '(' listexprcom ')' /* $foo->bar(list) */ + { $$ = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, scalar($1), $5), + newUNOP(OP_METHOD, 0, $3))); } + | term ARROW method /* $foo->bar */ + { $$ = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, scalar($1), + newUNOP(OP_METHOD, 0, $3))); } + | METHOD indirob listexpr /* new Class @args */ + { $$ = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, $2, $3), + newUNOP(OP_METHOD, 0, $1))); } + | FUNCMETH indirob '(' listexprcom ')' /* method $object (@args) */ + { $$ = convert(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, $2, $4), + newUNOP(OP_METHOD, 0, $1))); } + | LSTOP listexpr /* print @args */ { $$ = convert($1, 0, $2); } - | FUNC '(' listexpr ')' + | FUNC '(' listexprcom ')' /* print (@args) */ { $$ = convert($1, 0, $3); } + | LSTOPSUB startanonsub block /* map { foo } ... */ + { $3 = newANONATTRSUB($2, 0, Nullop, $3); } + listexpr %prec LSTOP /* ... @bar */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, + prepend_elem(OP_LIST, $3, $5), $1)); } + ; + +/* Names of methods. May use $object->$methodname */ +method : METHOD + | scalar ; -sexpr : sexpr '=' sexpr - { $$ = newASSIGNOP(OPf_STACKED, $1, $3); } - | sexpr POWOP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4)); } - | sexpr MULOP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4)); } - | sexpr ADDOP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4));} - | sexpr SHIFTOP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4)); } - | sexpr BITANDOP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4)); } - | sexpr BITOROP '=' sexpr - { $$ = newBINOP($2, OPf_STACKED, - mod(scalar($1), $2), scalar($4)); } - | sexpr ANDAND '=' sexpr - { $$ = newLOGOP(OP_ANDASSIGN, 0, - mod(scalar($1), OP_ANDASSIGN), - newUNOP(OP_SASSIGN, 0, scalar($4))); } - | sexpr OROR '=' sexpr - { $$ = newLOGOP(OP_ORASSIGN, 0, - mod(scalar($1), OP_ORASSIGN), - newUNOP(OP_SASSIGN, 0, scalar($4))); } - - - | sexpr POWOP sexpr +/* Some kind of subscripted expression */ +subscripted: star '{' expr ';' '}' /* *main::{something} */ + /* In this and all the hash accessors, ';' is + * provided by the tokeniser */ + { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); } + | scalar '[' expr ']' /* $array[$element] */ + { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); } + | term ARROW '[' expr ']' /* somearef->[$element] */ + { $$ = newBINOP(OP_AELEM, 0, + ref(newAVREF($1),OP_RV2AV), + scalar($4));} + | subscripted '[' expr ']' /* $foo->[$bar]->[$baz] */ + { $$ = newBINOP(OP_AELEM, 0, + ref(newAVREF($1),OP_RV2AV), + scalar($3));} + | scalar '{' expr ';' '}' /* $foo->{bar();} */ + { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3)); + PL_expect = XOPERATOR; } + | term ARROW '{' expr ';' '}' /* somehref->{bar();} */ + { $$ = newBINOP(OP_HELEM, 0, + ref(newHVREF($1),OP_RV2HV), + jmaybe($4)); + PL_expect = XOPERATOR; } + | subscripted '{' expr ';' '}' /* $foo->[bar]->{baz;} */ + { $$ = newBINOP(OP_HELEM, 0, + ref(newHVREF($1),OP_RV2HV), + jmaybe($3)); + PL_expect = XOPERATOR; } + | term ARROW '(' ')' /* $subref->() */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + newCVREF(0, scalar($1))); } + | term ARROW '(' expr ')' /* $subref->(@args) */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $4, + newCVREF(0, scalar($1)))); } + + | subscripted '(' expr ')' /* $foo->{bar}->(@args) */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $3, + newCVREF(0, scalar($1)))); } + | subscripted '(' ')' /* $foo->{bar}->() */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + newCVREF(0, scalar($1))); } + ; + +/* Binary operators between terms */ +termbinop : term ASSIGNOP term /* $x = $y */ + { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); } + | term POWOP term /* $x ** $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr MULOP sexpr + | term MULOP term /* $x * $y, $x x $y */ { if ($2 != OP_REPEAT) scalar($1); $$ = newBINOP($2, 0, $1, scalar($3)); } - | sexpr ADDOP sexpr + | term ADDOP term /* $x + $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr SHIFTOP sexpr + | term SHIFTOP term /* $x >> $y, $x << $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr RELOP sexpr + | term RELOP term /* $x > $y, etc. */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr EQOP sexpr + | term EQOP term /* $x == $y, $x eq $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr BITANDOP sexpr + | term BITANDOP term /* $x & $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr BITOROP sexpr + | term BITOROP term /* $x | $y */ { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | sexpr DOTDOT sexpr + | term DOTDOT term /* $x..$y, $x...$y */ { $$ = newRANGE($2, scalar($1), scalar($3));} - | sexpr ANDAND sexpr + | term ANDAND term /* $x && $y */ { $$ = newLOGOP(OP_AND, 0, $1, $3); } - | sexpr OROR sexpr + | term OROR term /* $x || $y */ { $$ = newLOGOP(OP_OR, 0, $1, $3); } - | sexpr ANDOP sexpr - { $$ = newLOGOP(OP_AND, 0, $1, $3); } - | sexpr OROP sexpr - { $$ = newLOGOP(OP_OR, 0, $1, $3); } - | sexpr '?' sexpr ':' sexpr - { $$ = newCONDOP(0, $1, $3, $5); } - | sexpr MATCHOP sexpr + | term DORDOR term /* $x // $y */ + { $$ = newLOGOP(OP_DOR, 0, $1, $3); } + | term MATCHOP term /* $x =~ /$y/ */ { $$ = bind_match($2, $1, $3); } - | term - { $$ = $1; } - ; + ; -term : '-' term %prec UMINUS +/* Unary operators and terms */ +termunop : '-' term %prec UMINUS /* -$x */ { $$ = newUNOP(OP_NEGATE, 0, scalar($2)); } - | '+' term %prec UMINUS + | '+' term %prec UMINUS /* +$x */ { $$ = $2; } - | '!' term + | '!' term /* !$x */ { $$ = newUNOP(OP_NOT, 0, scalar($2)); } - | '~' term + | '~' term /* ~$x */ { $$ = newUNOP(OP_COMPLEMENT, 0, scalar($2));} - | REFGEN term - { $$ = newUNOP(OP_REFGEN, 0, ref($2,OP_REFGEN)); } - | term POSTINC + | term POSTINC /* $x++ */ { $$ = newUNOP(OP_POSTINC, 0, mod(scalar($1), OP_POSTINC)); } - | term POSTDEC + | term POSTDEC /* $x-- */ { $$ = newUNOP(OP_POSTDEC, 0, mod(scalar($1), OP_POSTDEC)); } - | PREINC term + | PREINC term /* ++$x */ { $$ = newUNOP(OP_PREINC, 0, mod(scalar($2), OP_PREINC)); } - | PREDEC term + | PREDEC term /* --$x */ { $$ = newUNOP(OP_PREDEC, 0, mod(scalar($2), OP_PREDEC)); } - | LOCAL sexpr %prec UNIOP - { $$ = localize($2,$1); } - | '(' expr crp - { $$ = sawparens($2); } - | '(' ')' - { $$ = sawparens(newNULLLIST()); } - | '[' expr crb %prec '(' + + ; + +/* Constructors for anonymous data */ +anonymous: '[' expr ']' { $$ = newANONLIST($2); } - | '[' ']' %prec '(' + | '[' ']' { $$ = newANONLIST(Nullop); } - | HASHBRACK expr crhb %prec '(' + | HASHBRACK expr ';' '}' %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($2); } - | HASHBRACK ';' '}' %prec '(' + | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ { $$ = newANONHASH(Nullop); } + | ANONSUB startanonsub proto subattrlist block %prec '(' + { $$ = newANONATTRSUB($2, $3, $4, $5); } + + ; + +/* Things called with "do" */ +termdo : DO term %prec UNIOP /* do $filename */ + { $$ = dofile($2); } + | DO block %prec '(' /* do { code */ + { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); } + | DO WORD '(' ')' /* do somesub() */ + { $$ = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar($2) + )),Nullop)); dep();} + | DO WORD '(' expr ')' /* do somesub(@args) */ + { $$ = newUNOP(OP_ENTERSUB, + OPf_SPECIAL|OPf_STACKED, + append_elem(OP_LIST, + $4, + scalar(newCVREF( + (OPpENTERSUB_AMPER<<8), + scalar($2) + )))); dep();} + | DO scalar '(' ')' /* do $subref () */ + { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + scalar(newCVREF(0,scalar($2))), Nullop)); dep();} + | DO scalar '(' expr ')' /* do $subref (@args) */ + { $$ = newUNOP(OP_ENTERSUB, OPf_SPECIAL|OPf_STACKED, + prepend_elem(OP_LIST, + $4, + scalar(newCVREF(0,scalar($2))))); dep();} + + ; + +term : termbinop + | termunop + | anonymous + | termdo + | term '?' term ':' term + { $$ = newCONDOP(0, $1, $3, $5); } + | REFGEN term /* \$x, \@y, \%z */ + { $$ = newUNOP(OP_REFGEN, 0, mod($2,OP_REFGEN)); } + | myattrterm %prec UNIOP + { $$ = $1; } + | LOCAL term %prec UNIOP + { $$ = localize($2,$1); } + | '(' expr ')' + { $$ = sawparens($2); } + | '(' ')' + { $$ = sawparens(newNULLLIST()); } | scalar %prec '(' { $$ = $1; } | 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 '(' - { $$ = newBINOP(OP_AELEM, 0, - ref(newAVREF($1),OP_RV2AV), - scalar($3));} | hsh %prec '(' { $$ = $1; } | ary %prec '(' { $$ = $1; } - | arylen %prec '(' + | arylen %prec '(' /* $#x, $#{ something } */ { $$ = 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 '(' - { $$ = newBINOP(OP_HELEM, 0, - ref(newHVREF($1),OP_RV2HV), - jmaybe($3)); - expect = XOPERATOR; } - | '(' expr crp '[' expr ']' %prec '(' + | subscripted + { $$ = $1; } + | '(' expr ')' '[' expr ']' /* list slice */ { $$ = newSLICEOP(0, $5, $2); } - | '(' ')' '[' expr ']' %prec '(' + | '(' ')' '[' expr ']' /* empty list slice! */ { $$ = newSLICEOP(0, $4, Nullop); } - | ary '[' expr ']' %prec '(' + | ary '[' expr ']' /* array slice */ { $$ = prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), - list( newLISTOP(OP_ASLICE, 0, list($3), - ref($1, OP_ASLICE)))); } - | ary '{' expr ';' '}' %prec '(' + ref($1, OP_ASLICE))); } + | ary '{' expr ';' '}' /* @hash{@keys} */ { $$ = prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), - list( newLISTOP(OP_HSLICE, 0, list($3), - ref(oopsHV($1), OP_HSLICE)))); - expect = XOPERATOR; } - | DELETE scalar '{' expr ';' '}' %prec '(' - { $$ = newBINOP(OP_DELETE, 0, oopsHV($2), jmaybe($4)); - expect = XOPERATOR; } - | DELETE '(' scalar '{' expr ';' '}' ')' %prec '(' - { $$ = newBINOP(OP_DELETE, 0, oopsHV($3), jmaybe($5)); - expect = XOPERATOR; } + ref(oopsHV($1), OP_HSLICE))); + PL_expect = XOPERATOR; } | THING %prec '(' { $$ = $1; } - | amper - { $$ = newUNOP(OP_ENTERSUBR, 0, - scalar($1)); } - | amper '(' ')' - { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, scalar($1)); } - | amper '(' expr crp - { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, - list(prepend_elem(OP_LIST, scalar($1), $3))); } - | NOAMP WORD listexpr - { $$ = newUNOP(OP_ENTERSUBR, OPf_STACKED, - list(prepend_elem(OP_LIST, - newCVREF(scalar($2)), $3))); } - | NOAMP WORD indirob listexpr - { $$ = convert(OP_ENTERSUBR, OPf_STACKED|OPf_SPECIAL, - prepend_elem(OP_LIST, - newMETHOD($3,$2), list($4))); } - | DO sexpr %prec UNIOP - { $$ = newUNOP(OP_DOFILE, 0, scalar($2)); } - | DO block %prec '(' - { $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); } - | DO WORD '(' ')' - { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, - list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), Nullop))); } - | DO WORD '(' expr crp - { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, - list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), - $4))); } - | DO scalar '(' ')' - { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, - list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), Nullop)));} - | DO scalar '(' expr crp - { $$ = newUNOP(OP_ENTERSUBR, OPf_SPECIAL|OPf_STACKED, - list(prepend_elem(OP_LIST, - scalar(newCVREF(scalar($2))), - $4))); } - | LOOPEX + | amper /* &foo; */ + { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); } + | amper '(' ')' /* &foo() */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); } + | amper '(' expr ')' /* &foo(@args) */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $3, scalar($1))); } + | NOAMP WORD listexpr /* foo(@args) */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $3, scalar($2))); } + | LOOPEX /* loop exiting command (goto, last, dump, etc) */ { $$ = newOP($1, OPf_SPECIAL); - hints |= HINT_BLOCK_SCOPE; } - | LOOPEX sexpr + PL_hints |= HINT_BLOCK_SCOPE; } + | LOOPEX term { $$ = newLOOPEX($1,$2); } - | UNIOP + | NOTOP argexpr /* not $foo */ + { $$ = newUNOP(OP_NOT, 0, scalar($2)); } + | UNIOP /* Unary op, $_ implied */ { $$ = newOP($1, 0); } - | UNIOP block + | UNIOP block /* eval { foo }, I *think* */ { $$ = newUNOP($1, 0, $2); } - | UNIOP sexpr + | UNIOP term /* Unary op */ { $$ = newUNOP($1, 0, $2); } - | FUNC0 + | UNIOPSUB term /* Sub treated as unop */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + append_elem(OP_LIST, $2, scalar($1))); } + | FUNC0 /* Nullary operator */ { $$ = newOP($1, 0); } | FUNC0 '(' ')' { $$ = newOP($1, 0); } - | FUNC1 '(' ')' + | FUNC0SUB /* Sub treated as nullop */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, + scalar($1)); } + | FUNC1 '(' ')' /* not () */ { $$ = newOP($1, OPf_SPECIAL); } - | FUNC1 '(' expr ')' + | FUNC1 '(' expr ')' /* not($foo) */ { $$ = newUNOP($1, 0, $3); } - | PMFUNC '(' sexpr ')' + | PMFUNC '(' term ')' /* split (/foo/) */ { $$ = pmruntime($1, $3, Nullop); } - | PMFUNC '(' sexpr ',' sexpr ')' + | PMFUNC '(' term ',' term ')' /* split (/foo/,$bar) */ { $$ = pmruntime($1, $3, $5); } | WORD | listop ; -listexpr: /* NULL */ +/* "my" declarations, with optional attributes */ +myattrterm: MY myterm myattrlist + { $$ = my_attrs($2,$3); } + | MY myterm + { $$ = localize($2,$1); } + ; + +/* Things that can be "my"'d */ +myterm : '(' expr ')' + { $$ = sawparens($2); } + | '(' ')' + { $$ = sawparens(newNULLLIST()); } + | scalar %prec '(' + { $$ = $1; } + | hsh %prec '(' + { $$ = $1; } + | ary %prec '(' + { $$ = $1; } + ; + +/* Basic list expressions */ +listexpr: /* NULL */ %prec PREC_LOW + { $$ = Nullop; } + | argexpr %prec PREC_LOW + { $$ = $1; } + ; + +listexprcom: /* NULL */ { $$ = Nullop; } | expr { $$ = $1; } + | expr ',' + { $$ = $1; } + ; + +/* A little bit of trickery to make "for my $foo (@bar)" actually be + lexical */ +my_scalar: scalar + { PL_in_my = 0; $$ = my($1); } ; amper : '&' indirob - { $$ = newCVREF($2); } + { $$ = newCVREF($1,$2); } ; scalar : '$' indirob @@ -586,36 +777,27 @@ arylen : DOLSHARP indirob ; star : '*' indirob - { $$ = newGVREF($2); } + { $$ = newGVREF(0,$2); } ; +/* Indirect objects */ indirob : WORD { $$ = scalar($1); } - | scalar + | scalar %prec PREC_LOW { $$ = scalar($1); } | block - { $$ = scalar(scope($1)); } + { $$ = scope($1); } | PRIVATEREF { $$ = $1; } ; -crp : ',' ')' - { $$ = 1; } - | ')' - { $$ = 0; } - ; +%% /* PROGRAM */ -crb : ',' ']' - { $$ = 1; } - | ']' - { $$ = 0; } - ; +/* more stuff added to make perly_c.diff easier to apply */ -crhb : ',' ';' '}' - { $$ = 1; } - | ';' '}' - { $$ = 0; } - ; +#ifdef yyparse +#undef yyparse +#endif +#define yyparse() Perl_yyparse(pTHX) -%% /* PROGRAM */