Permalink
Browse files

[Yapsi] implemented if, if/else statements

This required a few new SIC opcodes, 'jf' (jump if false) and 'jmp'
(jump unconditionally).
  • Loading branch information...
masak committed Jun 1, 2010
1 parent b74b719 commit cc725ab939f4080cb14f191e78df3f23ef05058d
Showing with 94 additions and 5 deletions.
  1. +0 −1 README
  2. +79 −3 lib/Yapsi.pm
  3. +11 −1 t/compiler.t
  4. +4 −0 t/runtime.t
View
1 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
View
@@ -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}
View
@@ -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 { # '
View
@@ -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 {

0 comments on commit cc725ab

Please sign in to comment.