allow C-style for loops

rakudo-p5 · Apr 5, 2013 · f41550c · f41550c
1 parent 11b22cf
commit f41550c
Show file tree

Hide file tree

Showing 2 changed files with 36 additions and 37 deletions.
diff --git a/lib/Perl6/P5Actions.pm b/lib/Perl6/P5Actions.pm
@@ -879,13 +879,32 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
 
     method statement_control:sym<for>($/) {
         $DEBUG && say("statement_control:sym<for>($/)");
-        my $block := $<sblock>.ast;
-        my $past := QAST::Op.new(
-                        :op<callmethod>, :name<map>, :node($/),
-                        QAST::Op.new(:name('&infix:<,>'), :op('call'), $<EXPR>.ast),
-                        block_closure($block)
-        );
-        make $past;
+        if $<EXPR> {
+            $DEBUG && say("statement_control:sym<for>($/) if");
+            my $block := $<sblock>.ast;
+            my $past := QAST::Op.new(
+                            :op<callmethod>, :name<map>, :node($/),
+                            QAST::Op.new(:name('&infix:<,>'), :op('call'), $<EXPR>.ast),
+                            block_closure($block)
+            );
+            make $past;
+        }
+        else {
+            $DEBUG && say("statement_control:sym<for>($/) else");
+            # C-stye for loop
+            my $block := pblock_immediate($<sblock>.ast);
+            my $cond := $<e2> ?? $<e2>[0].ast !! QAST::Var.new(:name<True>, :scope<lexical>);
+            my $loop := QAST::Op.new( $cond, :op('while'), :node($/) );
+            $loop.push($block);
+            if $<e3> {
+                $loop.push($<e3>[0].ast);
+            }
+            $loop := tweak_loop($loop);
+            if $<e1> {
+                $loop := QAST::Stmts.new( $<e1>[0].ast, $loop, :node($/) );
+            }
+            make $loop;
+        }
     }
 
     method statement_control:sym<loop>($/) {

diff --git a/lib/Perl6/P5Grammar.pm b/lib/Perl6/P5Grammar.pm
@@ -1434,42 +1434,22 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
         <sym> <xblock>
     }
 
-#    rule statement_control:sym<for> {
-#        ['for'|'foreach']
-#        [
-#        ||  '('
-#            <e1=EXPR>? ';'
-#            <e2=EXPR>? ';'
-#            <e3=EXPR>?
-#        ')'
-#        || ['my'? <variable_declarator>]? '(' ~ ')' <EXPR>
-#        || <.panic: "Malformed loop spec">
-#        ]
-#        <sblock>
-#    }
     rule statement_control:sym<for> {
         :my $*FOR_VARIABLE;
         :my $*SCOPE;
         ['for'|'foreach']
-#        [
-#        ||  '('
-#            <e1=EXPR>? ';'
-#            <e2=EXPR>? ';'
-#            <e3=EXPR>?
-#        ')'
-#        || ['my'? <variable_declarator>]? '(' ~ ')' <EXPR>
-#        || <.panic: "Malformed loop spec">
-#        ]
-#        [ <?before 'my'? '$'\w+ '(' >
-#            <.typed_panic: 'X::Syntax::P5'> ]?
-#        [ <?before '(' <.EXPR>? ';' <.EXPR>? ';' <.EXPR>? ')' >
-#            <.obs('C-style "for (;;)" loop', '"loop (;;)"')> ]?
-#        $<signature>=[ ['my' { $*SCOPE := 'my' } ]? <variable_declarator> ]?
         [
-        || [ <variable> { $*FOR_VARIABLE := $<variable>; } ]?
-        || [ ['my' { $*SCOPE := 'my' } ]? <variable_declarator> { $*FOR_VARIABLE := $<variable_declarator>; } ]?
+        ||  '('
+                <e1=.EXPR>? ';'
+                <e2=.EXPR>? ';'
+                <e3=.EXPR>?
+            ')'
+        ||  [
+            || [ <variable> { $*FOR_VARIABLE := $<variable>; } ]?
+            || [ ['my' { $*SCOPE := 'my' } ]? <variable_declarator> { $*FOR_VARIABLE := $<variable_declarator>; } ]?
+            ]
+            '(' ~ ')' <EXPR>
         ]
-        '(' ~ ')' <EXPR>
         <sblock(1)>
     }