[Yapsi] implemented if, if/else statements

This required a few new SIC opcodes, 'jf' (jump if false) and 'jmp'
(jump unconditionally).

README

@@ -45,7 +45,6 @@ Could not parse
 
 Things we hope to implement in the immediate future:
 
-* If statements
 * Loops
 * Function calls
 * BEGIN, CHECK, INIT and END phasers

lib/Yapsi.pm

@@ -5,11 +5,14 @@ my $VERSION = '2010.07';
 grammar Yapsi::Perl6::Grammar {
     regex TOP { ^ <statementlist> <.ws> $ }
     regex statementlist { <statement> ** <eat_terminator> }
-    token statement { <expression> || '' }
+    token statement { <statement_control> || <expression> || '' }
     token eat_terminator { <?after '}'> \n || <.ws> ';' }
     token expression { <assignment> || <binding> || <variable> || <literal>
                        || <declaration> || <saycall> || <increment>
                        || <block> }
+    token statement_control { <statement_control_if> }
+    rule  statement_control_if { 'if' <expression> <block>
+                                 [ 'else' <else=block> ]? }
     token lvalue { <declaration> || <variable> || <increment> }
     token value { <variable> || <literal> || <declaration> || <saycall>
                   || <increment> }
@@ -52,7 +55,8 @@ class Yapsi::Compiler {
             }
         }
         push @sic, $INDENT ~ 'containers: ' ~ $*env.containers.perl;
-        my $*c = 0; # unique register counter; increases with each new register
+        my $*c = 0; # unique register counter
+        my $*l = 0; # unique label    counter
         my @*block-order;
         my %*blocks;
         $*current-block = '';
@@ -77,6 +81,11 @@ class Yapsi::Compiler {
         elsif $<expression> -> $e {
             self.find-vars($e, 'expression');
         }
+        # RAKUDO: Autovivification
+        elsif $<statement_control>
+              && $<statement_control><statement_control_if> -> $e {
+            self.find-vars($e, 'statement_control_if');
+        }
     }
 
     multi method find-vars(Match $/, 'expression') {
@@ -92,6 +101,18 @@ class Yapsi::Compiler {
         }
     }
 
+    multi method find-vars(Match $/, 'statement_control_if') {
+        self.find-vars($<expression>, 'expression');
+        my $remember-block = $*current-block;
+        self.find-vars($<block>, 'block');
+        $*current-block = $remember-block;
+        # RAKUDO: Autovivification
+        if $<else> && $<else>[0] -> $e {
+            self.find-vars($e, 'block');
+            $*current-block = $remember-block;
+        }
+    }
+
     multi method find-vars(Match $/, 'lvalue') {
         for <variable declaration> -> $subrule {
             if $/{$subrule} -> $e {
@@ -176,6 +197,10 @@ class Yapsi::Compiler {
         return '$' ~ $*c++;
     }
 
+    method unique-label {
+        return 'L' ~ $*l++;
+    }
+
     method add-code($line) {
         %*blocks{$*current-block}.push($line);
     }
@@ -185,14 +210,44 @@ class Yapsi::Compiler {
         if $<expression> && $<expression><block> -> $e {
             my $remember-block = $*current-block;
             my $block = self.sicify($e, 'block');
-            my $register = self.unique-register;
             $*current-block = $remember-block;
+            my $register = self.unique-register;
             self.add-code: "$register = fetch-block '$block'";
             self.add-code: "call $register";
         }
         elsif $<expression> -> $e {
             return self.sicify($e, 'expression');
         }
+        elsif $<statement_control>
+              && $<statement_control><statement_control_if> -> $e {
+            return self.sicify($e, 'statement_control_if');
+        }
+    }
+
+    multi method sicify(Match $/, 'statement_control_if') {
+        my ($register, $) = self.sicify($<expression>, 'expression');
+        my $remember-block = $*current-block;
+        my $block = self.sicify($<block>, 'block');
+        $*current-block = $remember-block;
+        my $after-if = self.unique-label;
+        self.add-code: "jf $register, $after-if";
+        $register = self.unique-register;
+        self.add-code: "$register = fetch-block '$block'";
+        self.add-code: "call $register";
+        my $after-else;
+        if $<else> {
+            $after-else = self.unique-label;
+            self.add-code: "jmp $after-else";
+        }
+        self.add-code: "`label $after-if";
+        if $<else> {
+            $block = self.sicify($<else>[0], 'block');
+            $*current-block = $remember-block;
+            $register = self.unique-register;
+            self.add-code: "$register = fetch-block '$block'";
+            self.add-code: "call $register";
+            self.add-code: "`label $after-else";
+        }
     }
 
     multi method sicify(Match $/, 'expression') {
@@ -423,6 +478,18 @@ class Yapsi::Runtime {
                     $ip = find-block(@sic, @r[+$0]) + 1;
                     $!current-block = @r[+$0];
                 }
+                when /^ 'jmp '(.*) $/ {
+                        $ip = find-label(@sic, ~$0);
+                }
+                when /^ 'jf $'(\d+)', '(.*) $/ {
+                    if @r[+$0] == 0 {
+                        $ip = find-label(@sic, ~$1);
+                        # XXX: This could result in $!current-block no longer
+                        #      being current, if the jump was to another block
+                    }
+                }
+                when /^ '`' / {
+                }
                 default { die "Couldn't handle instruction `$_`" }
             }
         }
@@ -437,6 +504,15 @@ class Yapsi::Runtime {
         die "Could not find block '$block-sought'";
     }
 
+    sub find-label(@sic, Str $label-sought) {
+        for ^@sic {
+            if @sic[$_] ~~ /^ \s+ '`label ' (.*)/ && ~$0 eq $label-sought {
+                return $_;
+            }
+        }
+        die "Could not find label '$label-sought'";
+    }
+
     sub locate-variable(%pads, $block is copy, Str $name) {
         loop {
             return %pads{$block}{$name}

t/compiler.t

@@ -27,15 +27,20 @@ my @programs-that-compile =
     'my $a; {}; say $a',
     "my \$a; \{\}\nsay \$a",
     'my $a; { say $a }',
+    'if 1 { say 42 }',
+    'my $a; if $a {}',
+    'if my $a {} else { say 42 }',
 ;
 
+sub escape($string) { $string.subst("\n", "\\n", :g) }
+
 for @programs-that-compile -> $program {
     my $can-compile = False;
     try {
         $c.compile($program);
         $can-compile = True;
     }
-    ok $can-compile, "will compile '$program'";
+    ok $can-compile, "will compile '{escape($program)}'";
 }
 
 my @programs-that-don't-compile =   # '
@@ -50,6 +55,11 @@ my @programs-that-don't-compile =   # '
     'say $a; my $a',
     '++42',
     '{ my $a }; say $a',
+    'else { 42 }',
+    'if 42 say 42',
+    'if $a {}',
+    'if 42 { $a }',
+    'if 5 {} else { $a }',
 ;
 
 for @programs-that-don't-compile -> $program { # '

t/runtime.t

@@ -27,6 +27,10 @@ my @tests =
     'my $a; { $a = 42 }; say $a',      "42\n",      'value survives block',
     'my $a = 42; {my $a = 7}; say $a', "42\n",      'initialised value survives block',
     '{}; my $a = 42; { say $a }',      "42\n",      'same-level blocks',
+    'if 42 { say 5 }',                 "5\n",       'executing if block',
+    'if 0 { say 5 }',                  "",          'non-executing if block',
+    'if 0 {} else { say 42 }',         "42\n",      'executing else block',
+    'if 5 {} else { say 42 }',         "",          'non-executing else block',
 ;
 
 for @tests -> $program, $expected, $message {