Perlito5 - implement "until"

fglock · Jan 19, 2015 · 3d0fa6d · 3d0fa6d
1 parent 9536839
commit 3d0fa6d
Show file tree

Hide file tree

Showing 8 changed files with 189 additions and 17 deletions.
diff --git a/TODO-perlito5 b/TODO-perlito5
@@ -342,9 +342,6 @@ TODO list for Perlito5
     $ node perlito5.js -I./src5/lib -Cjs -e ' @_ = (1,2);  &foo; '
     # call foo(@_)
 
--- do {} while / do {} until
-    execute the loop once, before checking the condition
-
 -- while () {}
     this is implemented - it now needs some tests:
     # http://blogs.perl.org/users/peter_martini/2014/05/spelunking-why-while-is-my-new-favorite-perl-ism.html

diff --git a/perlito5.pl b/perlito5.pl
diff --git a/src5/lib/Perlito5/Grammar/Control.pm b/src5/lib/Perlito5/Grammar/Control.pm
@@ -8,6 +8,7 @@ Perlito5::Grammar::Statement::add_statement( 'for'     => sub { Perlito5::Gramma
 Perlito5::Grammar::Statement::add_statement( 'foreach' => sub { Perlito5::Grammar->for( $_[0], $_[1] ) } );
 Perlito5::Grammar::Statement::add_statement( 'when'    => sub { Perlito5::Grammar->when( $_[0], $_[1] ) } );
 Perlito5::Grammar::Statement::add_statement( 'while'   => sub { Perlito5::Grammar->while( $_[0], $_[1] ) } );
+Perlito5::Grammar::Statement::add_statement( 'until'   => sub { Perlito5::Grammar->until( $_[0], $_[1] ) } );
 Perlito5::Grammar::Statement::add_statement( 'given'   => sub { Perlito5::Grammar->given( $_[0], $_[1] ) } );
 Perlito5::Grammar::Statement::add_statement( 'unless'  => sub { Perlito5::Grammar->unless( $_[0], $_[1] ) } );
 
@@ -204,6 +205,31 @@ token while {
         }
 };
 
+token until {
+    'until' <.Perlito5::Grammar::Space.opt_ws>
+            '(' <Perlito5::Grammar::Expression.paren_parse>   ')' <.Perlito5::Grammar::Space.opt_ws>
+            '{' <.Perlito5::Grammar::Space.opt_ws>
+                <Perlito5::Grammar.exp_stmts>
+                <.Perlito5::Grammar::Space.opt_ws>
+            '}' <.Perlito5::Grammar::Space.opt_ws>
+    <opt_continue_block>
+        {
+            my $cond = Perlito5::Match::flat($MATCH->{"Perlito5::Grammar::Expression.paren_parse"});
+            if ($cond eq '*undef*') {
+                $cond = Perlito5::AST::Val::Int->new( int => 1 );
+            }
+            $MATCH->{capture} = Perlito5::AST::While->new( 
+                    cond  => Perlito5::AST::Apply->new(
+                                'arguments' => [ $cond ],
+                                'code'      => 'prefix:<!>',
+                                'namespace' => '',
+                            ),
+                    body  => Perlito5::AST::Lit::Block->new( stmts => Perlito5::Match::flat($MATCH->{"Perlito5::Grammar.exp_stmts"}), sig => undef ),
+                    continue => $MATCH->{opt_continue_block}{capture}
+                 )
+        }
+};
+
 token given {
     'given' <.Perlito5::Grammar::Space.opt_ws> '(' <Perlito5::Grammar::Expression.paren_parse>   ')' <.Perlito5::Grammar::Space.opt_ws>
             '{' <.Perlito5::Grammar::Space.opt_ws>

diff --git a/src5/lib/Perlito5/Grammar/Expression.pm b/src5/lib/Perlito5/Grammar/Expression.pm
@@ -546,6 +546,7 @@ my $Argument_end_token = {
         'when' => 1,
 
         'while' => 1,
+        'until' => 1,
         # 'elsif' => 1,
 
         'unless' => 1,
@@ -573,6 +574,7 @@ my $List_end_token = {
         'when' => 1,
 
         'while' => 1,
+        'until' => 1,
         'elsif' => 1,
 
         'unless' => 1,
@@ -595,6 +597,7 @@ my $Expr_end_token = {
         'when' => 1,
 
         'while' => 1,
+        'until' => 1,
         'elsif' => 1,
 
         'unless' => 1,

diff --git a/src5/lib/Perlito5/Grammar/Statement.pm b/src5/lib/Perlito5/Grammar/Statement.pm
@@ -135,6 +135,7 @@ my %Modifier = (
     'for'    => 1, 
     'foreach'=> 1, 
     'while'  => 1, 
+    'until'  => 1, 
     'given'  => 1,
 );
 
@@ -204,6 +205,19 @@ sub modifier {
             ) 
         };
     }
+    if ($modifier eq 'until') {
+        return {
+            'str' => $str, 'from' => $pos, 'to' => $modifier_exp->{to},
+            capture => Perlito5::AST::While->new(
+                cond     => Perlito5::AST::Apply->new(
+                                'arguments' => [ Perlito5::Match::flat($modifier_exp) ],
+                                'code'      => 'prefix:<!>',
+                                'namespace' => '',
+                            ),
+                body     => $expression,
+            ) 
+        };
+    }
     if  (  $modifier eq 'for'
         || $modifier eq 'foreach'
         ) 

diff --git a/src5/lib/Perlito5/Javascript2/Emitter.pm b/src5/lib/Perlito5/Javascript2/Emitter.pm
@@ -3036,6 +3036,11 @@ package Perlito5::AST::While;
         my $wantarray = shift;
 
         my $cond = $self->{cond};
+
+        # body is 'Perlito5::AST::Do' in this construct:
+        #   do { ... } while ...;
+        my $do_at_least_once = ref($self->{body}) eq 'Perlito5::AST::Do' ? 1 : 0;
+
         my $body =
               ref($self->{body}) ne 'Perlito5::AST::Lit::Block'
             ? [ $self->{body} ]
@@ -3061,7 +3066,8 @@ package Perlito5::AST::While;
                     . Perlito5::Javascript2::tab($level + 1) . '}, '
                     . Perlito5::Javascript2::emit_function_javascript2($level + 1, 'void', $cond) . ', '
                     . Perlito5::AST::Lit::Block::emit_javascript2_continue($self, $level) . ', '
-                    .   '"' . ($self->{label} || "") . '"'
+                    .   '"' . ($self->{label} || "") . '", '
+                    . $do_at_least_once
                     . ')';
 
         if (keys %{ $Perlito5::VAR->[0] }) {

diff --git a/src5/lib/Perlito5/Javascript2/Runtime.pm b/src5/lib/Perlito5/Javascript2/Runtime.pm
@@ -1008,17 +1008,16 @@ var p5for_lex = function(func, args, cont, label) {
     }
 };
 
-var p5while = function(func, cond, cont, label) {
-    var _redo = false;
-    while (_redo || p5bool(cond())) {
-        _redo = false;
+var p5while = function(func, cond, cont, label, redo) {
+    while (redo || p5bool(cond())) {
+        redo = false;
         try {
             func()
         }
         catch(err) {
             if (err instanceof p5_error && err.v == label) {
                 if (err.type == 'last') { return }
-                else if (err.type == 'redo') { _redo = true }
+                else if (err.type == 'redo') { redo = true }
                 else if (err.type != 'next') { throw(err) }
             }            
             else {
@@ -1027,12 +1026,12 @@ var p5while = function(func, cond, cont, label) {
         }
         if (cont) {
             try {
-                if (!_redo) { cont() }
+                if (!redo) { cont() }
             }
             catch(err) {
                 if (err instanceof p5_error && err.v == label) {
                     if (err.type == 'last') { return }
-                    else if (err.type == 'redo') { _redo = true }
+                    else if (err.type == 'redo') { redo = true }
                     else if (err.type != 'next') { throw(err) }
                 }            
                 else {

diff --git a/t5/01-perlito/165-do-while.t b/t5/01-perlito/165-do-while.t
@@ -0,0 +1,29 @@
+use v5;
+use strict;
+use feature 'say';
+
+# do {} while / do {} until
+#  execute the loop once, before checking the condition
+
+    say '1..5';
+    my $a = 4;
+    my $b = 0;
+    do {
+        $b = $b + 2;
+        $a = $a - 1;
+    } while ($a);
+    if ($b == 8) {
+        say "ok 1";
+    }
+
+    my @x = ( 2, 3, 4 );
+    do {
+        say "ok ", (shift @x); 
+    } until @x;
+
+    say "ok ", (shift @x)
+        if @x; 
+
+    @x = ( 4, 5 );
+    say "ok ", (shift @x)
+        while @x;