Skip to content

Commit

Permalink
[Yapsi] implemented if, if/else statements
Browse files Browse the repository at this point in the history 
This required a few new SIC opcodes, 'jf' (jump if false) and 'jmp'
(jump unconditionally).
  • Loading branch information
Carl Masak committed Jul 1, 2010
1 parent b74b719 commit cc725ab
Show file tree
Hide file tree
Showing 4 changed files with 94 additions and 5 deletions.
1 change: 0 additions & 1 deletion README
View file
Expand Up @@ -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
Expand Down
82 changes: 79 additions & 3 deletions lib/Yapsi.pm
View file
Expand Up @@ -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> }
Expand Down Expand Up @@ -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 = '';
Expand All @@ -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') {
Expand All @@ -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 {
Expand Down Expand Up @@ -176,6 +197,10 @@ class Yapsi::Compiler {
return '$' ~ $*c++;
}

method unique-label {
return 'L' ~ $*l++;
}

method add-code($line) {
%*blocks{$*current-block}.push($line);
}
Expand All @@ -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') {
Expand Down Expand Up @@ -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 `$_`" }
}
}
Expand All @@ -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}
Expand Down
12 changes: 11 additions & 1 deletion t/compiler.t
View file
Expand Up @@ -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 = # '
Expand All @@ -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 { # '
Expand Down
4 changes: 4 additions & 0 deletions t/runtime.t
View file
Expand Up @@ -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 {
Expand Down

0 comments on commit cc725ab

Please sign in to comment.