/*
* '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.'
*/
%{
%token <ival> FORMAT SUB ANONSUB PACKAGE USE
%token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
%token <ival> LOOPEX DOTDOT
-%token <ival> FUNC0 FUNC1 FUNC
+%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
%token <ival> RELOP EQOP MULOP ADDOP
%token <ival> DOLSHARP DO HASHBRACK NOAMP
%token LOCAL MY
-%type <ival> prog decl local format startsub remember mremember '&'
-%type <opval> block mblock mintro lineseq line loop cond else
+%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> remember mremember '&'
+%type <opval> block mblock lineseq line loop cond else
%type <opval> expr term scalar ary hsh arylen star amper sideff
-%type <opval> argexpr nexpr texpr iexpr mexpr mtexpr miexpr
-%type <opval> listexpr listexprcom indirob
-%type <opval> listop method proto cont my_scalar
+%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
+%type <opval> listexpr listexprcom indirob listop method
+%type <opval> formname subname proto subbody cont my_scalar
%type <pval> label
%left <ival> OROP
%left ANDOP
%right NOTOP
-%nonassoc <ival> LSTOP
+%nonassoc LSTOP LSTOPSUB
%left ','
%right <ival> ASSIGNOP
%right '?' ':'
%left <ival> BITANDOP
%nonassoc EQOP
%nonassoc RELOP
-%nonassoc <ival> UNIOP
+%nonassoc UNIOP UNIOPSUB
%left <ival> SHIFTOP
%left ADDOP
%left MULOP
;
block : '{' remember lineseq '}'
- { $$ = block_end($1,$2,$3); }
+ { if (copline > (line_t)$1)
+ copline = $1;
+ $$ = block_end($2, $3); }
;
remember: /* NULL */ /* start a full lexical scope */
{ $$ = block_start(TRUE); }
;
-mblock : '{' mintro mremember lineseq '}'
- { if ($2)
- $4 = $4 ? append_list(OP_LINESEQ,
- (LISTOP*)$2, (LISTOP*)$4) : $2;
- $$ = block_end($1, $3, $4); }
- ;
-
-mintro : /* NULL */ /* introduce pending lexicals */
- { $$ = min_intro_pending
- ? newSTATEOP(0, Nullch, newOP(OP_NULL, 0))
- : NULL; }
+mblock : '{' mremember lineseq '}'
+ { if (copline > (line_t)$1)
+ copline = $1;
+ $$ = block_end($2, $3); }
;
mremember: /* NULL */ /* start a partial lexical scope */
{ $$ = scope($2); }
| ELSIF '(' mexpr ')' mblock else
{ copline = $1;
- $$ = newCONDOP(0, $3, scope($5), $6);
+ $$ = newSTATEOP(0, Nullch,
+ newCONDOP(0, $3, scope($5), $6));
hints |= HINT_BLOCK_SCOPE; }
;
cond : IF '(' remember mexpr ')' mblock else
{ copline = $1;
- $$ = block_end($1, $3,
- newCONDOP(0, $4, scope($6), $7)); }
+ $$ = block_end($3,
+ newCONDOP(0, $4, scope($6), $7)); }
| UNLESS '(' remember miexpr ')' mblock else
{ copline = $1;
- $$ = block_end($1, $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); }
+ $$ = block_end($3,
+ newCONDOP(0, $4, scope($6), $7)); }
;
cont : /* NULL */
loop : label WHILE '(' remember mtexpr ')' mblock cont
{ copline = $2;
- $$ = block_end($2, $4,
+ $$ = block_end($4,
newSTATEOP(0, $1,
- newWHILEOP(0, 1, (LOOP*)Nullop,
- $5, $7, $8) )); }
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ $5, $7, $8))); }
| label UNTIL '(' remember miexpr ')' mblock cont
{ copline = $2;
- $$ = block_end($2, $4,
+ $$ = block_end($4,
newSTATEOP(0, $1,
- newWHILEOP(0, 1, (LOOP*)Nullop,
- $5, $7, $8) )); }
- | 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 MY remember my_scalar '(' expr ')' mblock cont
- { $$ = block_end($2, $4,
- newFOROP(0, $1, $2, $5, $7, $9, $10)); }
- | label FOR scalar '(' expr ')' block cont
- { $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
- $5, $7, $8); }
- | label FOR '(' remember expr ')' mblock cont
- { $$ = block_end($2, $4,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ $5, $7, $8))); }
+ | label FOR MY remember my_scalar '(' mexpr ')' mblock cont
+ { $$ = block_end($4,
+ newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+ | label FOR scalar '(' remember mexpr ')' mblock cont
+ { $$ = block_end($5,
+ newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+ $6, $8, $9)); }
+ | label FOR '(' remember mexpr ')' mblock cont
+ { $$ = block_end($4,
newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
- | label FOR '(' remember nexpr ';'
- { if ($5) {
- $5 = scalar($5);
- if (min_intro_pending)
- $5 = newSTATEOP(0, Nullch, $5); } }
- texpr ';'
- { $8 = scalar($8);
- if (min_intro_pending)
- $8 = newSTATEOP(0, Nullch, $8); }
- nexpr ')' mblock
+ | label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
/* basically fake up an initialize-while lineseq */
{ copline = $2;
- $$ = block_end($2, $4,
- append_elem(OP_LINESEQ, $5,
- newSTATEOP(0, $1,
- newWHILEOP(0, 1, (LOOP*)Nullop,
- $8, $13, scalar($11))))); }
+ $$ = block_end($4,
+ append_elem(OP_LINESEQ, scalar($5),
+ newSTATEOP(0, $1,
+ newWHILEOP(0, 1, (LOOP*)Nullop,
+ scalar($7),
+ $11, scalar($9))))); }
| label block cont /* a block is a loop that happens once */
{ $$ = newSTATEOP(0,
$1, newWHILEOP(0, 1, (LOOP*)Nullop,
;
mexpr : expr
- { $$ = min_intro_pending
- ? newSTATEOP(0, Nullch, $1) : $1; }
+ { $$ = $1; intro_my(); }
+ ;
+
+mnexpr : nexpr
+ { $$ = $1; intro_my(); }
;
mtexpr : texpr
- { $$ = min_intro_pending
- ? newSTATEOP(0, Nullch, $1) : $1; }
+ { $$ = $1; intro_my(); }
;
miexpr : iexpr
- { $$ = min_intro_pending
- ? newSTATEOP(0, Nullch, $1) : $1; }
+ { $$ = $1; intro_my(); }
;
label : /* empty */
{ $$ = 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 = SvPVx(((SVOP*)$1)->op_sv, na);
+ if (strEQ(name, "BEGIN") || strEQ(name, "END"))
+ 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 ';'
{ 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
{ $$ = 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
{ $$ = newANONHASH($2); }
| HASHBRACK ';' '}' %prec '('
{ $$ = newANONHASH(Nullop); }
- | ANONSUB startsub proto block %prec '('
+ | ANONSUB startanonsub proto block %prec '('
{ $$ = newANONSUB($2, $3, $4); }
| scalar %prec '('
{ $$ = $1; }
| FUNC0 '(' ')'
{ $$ = newOP($1, 0); }
| FUNC0SUB
- { $$ = newUNOP(OP_ENTERSUB, 0,
+ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
scalar($1)); }
| FUNC1 '(' ')'
{ $$ = newOP($1, OPf_SPECIAL); }