refactor and regularise label/statement grammar

Refactoring of the grammar around statements.  New production <barestmt>
encompasses a statement without label.  It includes all statement types,
including declarations, with no unnecessary intermediate non-terminals.
It generates an op tree for the statement's content, with no leading
state op.  The <fullstmt> production has just one rule, consisting of
optional label followed by <barestmt>.  It puts a state op on the front
of the statement's content ops.

To support the regular statement op structure, the op sequence for for(;;)
loops no longer has a second state op between the initialisation and
the loop.  Instead, the unstack op type is slightly adapted to achieve
the stack clearing without a state op.

The newFOROP() constructor function no longer generates a state op,
that now being the job of the <fullstmt> production.  Consequently it
no longer takes a parameter stating what label is to go in the state op.
This brings it in line with the other op constructors.

Author: Zefram

dist/B-Deparse/Deparse.pm

@@ -23,7 +23,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
 	 ($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE'),
 	 ($] < 5.011 ? 'CVf_LOCKED' : ());
-$VERSION = 0.99;
+$VERSION = 1.00;
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -958,14 +958,19 @@ sub is_for_loop {
     my $op = shift;
     # This OP might be almost anything, though it won't be a
     # nextstate. (It's the initialization, so in the canonical case it
-    # will be an sassign.) The sibling is a lineseq whose first child
-    # is a nextstate and whose second is a leaveloop.
+    # will be an sassign.) The sibling is (old style) a lineseq whose
+    # first child is a nextstate and whose second is a leaveloop, or
+    # (new style) an unstack whose sibling is a leaveloop.
     my $lseq = $op->sibling;
-    if (!is_state $op and !null($lseq) and $lseq->name eq "lineseq") {
+    return 0 unless !is_state($op) and !null($lseq);
+    if ($lseq->name eq "lineseq") {
 	if ($lseq->first && !null($lseq->first) && is_state($lseq->first)
 	    && (my $sib = $lseq->first->sibling)) {
 	    return (!null($sib) && $sib->name eq "leaveloop");
 	}
+    } elsif ($lseq->name eq "unstack" && ($lseq->flags & OPf_SPECIAL)) {
+	my $sib = $lseq->sibling;
+	return $sib && !null($sib) && $sib->name eq "leaveloop";
     }
     return 0;
 }
@@ -1215,7 +1220,8 @@ sub walk_lineseq {
 	    }
 	}
 	if (is_for_loop($kids[$i])) {
-	    $callback->($expr . $self->for_loop($kids[$i], 0), $i++);
+	    $callback->($expr . $self->for_loop($kids[$i], 0),
+		$i += $kids[$i]->sibling->name eq "unstack" ? 2 : 1);
 	    next;
 	}
 	$expr .= $self->deparse($kids[$i], (@kids != 1)/2);
@@ -2757,7 +2763,9 @@ sub for_loop {
     my $self = shift;
     my($op, $cx) = @_;
     my $init = $self->deparse($op, 1);
-    return $self->loop_common($op->sibling->first->sibling, $cx, $init);
+    my $s = $op->sibling;
+    my $ll = $s->name eq "unstack" ? $s->sibling : $s->first->sibling;
+    return $self->loop_common($ll, $cx, $init);
 }
 
 sub pp_leavetry {

embed.fnc

@@ -780,7 +780,7 @@ Ap	|OP*	|newFORM	|I32 floor|NULLOK OP* o|NULLOK OP* block
 #else
 Ap	|void	|newFORM	|I32 floor|NULLOK OP* o|NULLOK OP* block
 #endif
-Apda	|OP*	|newFOROP	|I32 flags|NULLOK char* label|line_t forline \
+Apda	|OP*	|newFOROP	|I32 flags|line_t forline \
 				|NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont
 Apda	|OP*	|newGIVENOP	|NN OP* cond|NN OP* block|PADOFFSET defsv_off
 Apda	|OP*	|newLOGOP	|I32 optype|I32 flags|NN OP *first|NN OP *other

embed.h

@@ -311,7 +311,7 @@
 #define newCONDOP(a,b,c,d)	Perl_newCONDOP(aTHX_ a,b,c,d)
 #define newCONSTSUB(a,b,c)	Perl_newCONSTSUB(aTHX_ a,b,c)
 #define newCVREF(a,b)		Perl_newCVREF(aTHX_ a,b)
-#define newFOROP(a,b,c,d,e,f,g)	Perl_newFOROP(aTHX_ a,b,c,d,e,f,g)
+#define newFOROP(a,b,c,d,e,f)	Perl_newFOROP(aTHX_ a,b,c,d,e,f)
 #define newGIVENOP(a,b,c)	Perl_newGIVENOP(aTHX_ a,b,c)
 #define newGVOP(a,b,c)		Perl_newGVOP(aTHX_ a,b,c)
 #define newGVREF(a,b)		Perl_newGVREF(aTHX_ a,b)

ext/B/t/f_map.t

@@ -185,7 +185,7 @@ checkOptree(note   => q{},
 # p      <2> sassign vKS/2
 # q      <0> unstack s
 #            goto r
-# t  <2> leaveloop K/2
+# t  <2> leaveloop KP/2
 # u  <2> leaveloop K/2
 # v  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
@@ -218,7 +218,7 @@ EOT_EOT
 # p      <2> sassign vKS/2
 # q      <0> unstack s
 #            goto r
-# t  <2> leaveloop K/2
+# t  <2> leaveloop KP/2
 # u  <2> leaveloop K/2
 # v  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT

ext/B/t/optree_samples.t

@@ -281,7 +281,6 @@ checkOptree ( name	=> '-basic sub { print "foo $_" foreach (1..10) }',
 # g  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->g
 # 1        <;> nextstate(main 445 optree.t:167) v:>,<,% ->2
-# -        <0> null v ->-
 # f        <2> leaveloop K/2 ->g
 # 6           <{> enteriter(next->c last->f redo->7) lKS/8 ->d
 # -              <0> ex-pushmark s ->2
@@ -307,7 +306,6 @@ EOT_EOT
 # g  <1> leavesub[1 ref] K/REFC,1 ->(end)
 # -     <@> lineseq KP ->g
 # 1        <;> nextstate(main 446 optree_samples.t:192) v:>,<,% ->2
-# -        <0> null v ->-
 # f        <2> leaveloop K/2 ->g
 # 6           <{> enteriter(next->c last->f redo->7) lKS/8 ->d
 # -              <0> ex-pushmark s ->2
@@ -337,7 +335,7 @@ checkOptree ( name	=> '-exec -e foreach (1..10) {print qq{foo $_}}',
 	      strip_open_hints => 1,
 	      expect	=> <<'EOT_EOT', expect_nt => <<'EONT_EONT');
 # 1  <0> enter 
-# 2  <;> nextstate(main 2 -e:1) v:>,<,%
+# 2  <;> nextstate(main 2 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
 # 4  <$> const[IV 1] s
 # 5  <$> const[IV 10] s
@@ -357,7 +355,7 @@ checkOptree ( name	=> '-exec -e foreach (1..10) {print qq{foo $_}}',
 # i  <@> leave[1 ref] vKP/REFC
 EOT_EOT
 # 1  <0> enter 
-# 2  <;> nextstate(main 2 -e:1) v:>,<,%
+# 2  <;> nextstate(main 2 -e:1) v:>,<,%,{
 # 3  <0> pushmark s
 # 4  <$> const(IV 1) s
 # 5  <$> const(IV 10) s
@@ -545,7 +543,7 @@ checkOptree ( name	=> '%h=(); for $_(@a){$h{getkey($_)} = $_}',
 # n      <2> sassign vKS/2
 # o      <0> unstack s
 #            goto p
-# r  <2> leaveloop K/2
+# r  <2> leaveloop KP/2
 # s  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 505 (eval 24):1) v
@@ -575,7 +573,7 @@ EOT_EOT
 # n      <2> sassign vKS/2
 # o      <0> unstack s
 #            goto p
-# r  <2> leaveloop K/2
+# r  <2> leaveloop KP/2
 # s  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 

op.c

@@ -5429,7 +5429,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 }
 
 /*
-=for apidoc Am|OP *|newFOROP|I32 flags|char *label|line_t forline|OP *sv|OP *expr|OP *block|OP *cont
+=for apidoc Am|OP *|newFOROP|I32 flags|line_t forline|OP *sv|OP *expr|OP *block|OP *cont
 
 Constructs, checks, and returns an op tree expressing a C<foreach>
 loop (iteration through a list of values).  This is a heavyweight loop,
@@ -5447,16 +5447,13 @@ I<flags> gives the eight bits of C<op_flags> for the C<leaveloop>
 op and, shifted up eight bits, the eight bits of C<op_private> for
 the C<leaveloop> op, except that (in both cases) some bits will be set
 automatically.  I<forline> is the line number that should be attributed
-to the loop's list expression.  If I<label> is non-null, it supplies
-the name of a label to attach to the state op at the start of the loop;
-this function takes ownership of the memory pointed at by I<label>,
-and will free it.
+to the loop's list expression.
 
 =cut
 */
 
 OP *
-Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP *block, OP *cont)
+Perl_newFOROP(pTHX_ I32 flags, line_t forline, OP *sv, OP *expr, OP *block, OP *cont)
 {
     dVAR;
     LOOP *loop;
@@ -5577,8 +5574,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
     if (madsv)
 	op_getmad(madsv, (OP*)loop, 'v');
-    PL_parser->copline = forline;
-    return newSTATEOP(0, label, wop);
+    return wop;
 }
 
 /*