Added 'unless' keyword.

masak · Aug 31, 2010 · 21732ee · 21732ee
1 parent 7674823
commit 21732ee
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 3 deletions.
diff --git a/doc/LOLHALP b/doc/LOLHALP
@@ -1,7 +1,7 @@
 The below things should be fairly straightforward to implement. Just look in
 the commit logs at how similar features were implemented.
 
-* 'unless' and 'until' keywords.
+* 'until' keywords.
 * 'loop' keyword. (at least the infinitely looping version is easy.)
 * 'repeat' keyword.
 * 'ENTER', 'LEAVE', 'FIRST', 'NEXT', and 'LAST' phasers.

diff --git a/lib/Yapsi.pm b/lib/Yapsi.pm
@@ -17,10 +17,12 @@ grammar Yapsi::Perl6::Grammar {
                        || <declaration> || <block>
                        || <saycall> || <increment> || <decrement> }
     token statement_control { <statement_control_if>
-                              || <statement_control_while> }
+                              || <statement_control_while> 
+                              || <statement_control_unless> }
     rule  statement_control_if { 'if' <expression> <block>
                                  [ 'else' <else=.block> ]? }
     rule  statement_control_while { 'while' <expression> <block> }
+    rule statement_control_unless { 'unless' <expression> <block> }
     token lvalue { <declaration> || <variable> || <increment> }
     token value { <variable> || <literal> || <declaration> || <saycall>
                   || <increment> }
@@ -118,7 +120,7 @@ class Yapsi::Compiler {
                 my $*c = 0; # unique register counter
                 my $*l = 0; # unique label    counter
                 my @skip = 'block', 'statement_control_if',
-                           'statement_control_while';
+                           'statement_control_while', 'statement_control_unless';
                 my &sicify = -> $/, $key {
                     if $m !=== $/ && $key eq 'block' {
                         my $register = self.unique-register;
@@ -157,6 +159,23 @@ class Yapsi::Compiler {
                                 "`label $after-else";
                         }
                     }
+                    elsif $key eq 'statement_control_unless' {
+                        traverse-bottom-up(
+                            $<expression>,
+                            :key<expression>,
+                            :@skip,
+                            :action(&sicify)
+                        );
+                        my ($register, $) = $<expression>.ast.list;
+                        my $block-name = $<block>.ast<name>;
+                        my $after-unless = self.unique-label;
+                        push @blocksic, "jt $register, $after-unless";
+                        $register = self.unique-register;
+                        push @blocksic,
+                            "$register = closure-from-block '$block-name'",
+                            "call $register";
+                        push @blocksic, "`label $after-unless";
+                    }
                     elsif $key eq 'statement_control_while' {
                         my $before-while = self.unique-label;
                         my $after-while = self.unique-label;
@@ -457,6 +476,11 @@ class Yapsi::Runtime {
                             $ip = find-label(@sic, ~$1);
                         }
                     }
+                    when / ^ 'jt $'(\d+)', '(\S+) $ / {
+                        if reg[+$0] != 0 {
+                            $ip = find-label(@sic, ~$1);
+                        }
+                    }
                     when / ^ 'jmp '(\S+) $ / {
                         $ip = find-label(@sic, ~$0);
                     }

diff --git a/t/compiler.t b/t/compiler.t
@@ -61,6 +61,8 @@ my @programs-that-don't-compile =   # '
     'if $a {}',
     'if 42 { $a }',
     'if 5 {} else { $a }',
+    'unless 0 { say "unless" }',
+    'unless $a { say $a }'
 ;
 
 for @programs-that-don't-compile -> $program { # '

diff --git a/t/runtime.t b/t/runtime.t
@@ -34,6 +34,8 @@ my @tests =
     'my $a = 4; while --$a { say $a }',
                                        "3\n2\n1\n", 'while loop',
     'my $a; while $a { say 42 }',      "",          'non-executing while loop',
+    'my $a = 42;unless $a { say 24 }',  "",          'non-executing unless block',
+    'unless 0 { say 42 }',  "42\n",       'executing unless block',
 #   TODO -- Need to "instantiate" lexpads from some kind of "proto-lexpads"
 #    'my $a = 3; while --$a { say my $b; $b = 42 }', "Any()\nAny()\n",
 #                'each time a block is entered, it gets a fresh lexical pad',