From cc725ab939f4080cb14f191e78df3f23ef05058d Mon Sep 17 00:00:00 2001 From: Carl Masak Date: Tue, 1 Jun 2010 23:13:22 +0200 Subject: [PATCH] [Yapsi] implemented if, if/else statements This required a few new SIC opcodes, 'jf' (jump if false) and 'jmp' (jump unconditionally). --- README | 1 - lib/Yapsi.pm | 82 ++++++++++++++++++++++++++++++++++++++++++++++++++-- t/compiler.t | 12 +++++++- t/runtime.t | 4 +++ 4 files changed, 94 insertions(+), 5 deletions(-) diff --git a/README b/README index a0d8c05..9402302 100644 --- a/README +++ b/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 diff --git a/lib/Yapsi.pm b/lib/Yapsi.pm index f71250b..c881f08 100644 --- a/lib/Yapsi.pm +++ b/lib/Yapsi.pm @@ -5,11 +5,14 @@ my $VERSION = '2010.07'; grammar Yapsi::Perl6::Grammar { regex TOP { ^ <.ws> $ } regex statementlist { ** } - token statement { || '' } + token statement { || || '' } token eat_terminator { \n || <.ws> ';' } token expression { || || || || || || || } + token statement_control { } + rule statement_control_if { 'if' + [ 'else' ]? } token lvalue { || || } token value { || || || || } @@ -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 $ -> $e { self.find-vars($e, 'expression'); } + # RAKUDO: Autovivification + elsif $ + && $ -> $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'); + my $remember-block = $*current-block; + self.find-vars($, 'block'); + $*current-block = $remember-block; + # RAKUDO: Autovivification + if $ && $[0] -> $e { + self.find-vars($e, 'block'); + $*current-block = $remember-block; + } + } + multi method find-vars(Match $/, 'lvalue') { for -> $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 $ && $ -> $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 $ -> $e { return self.sicify($e, 'expression'); } + elsif $ + && $ -> $e { + return self.sicify($e, 'statement_control_if'); + } + } + + multi method sicify(Match $/, 'statement_control_if') { + my ($register, $) = self.sicify($, 'expression'); + my $remember-block = $*current-block; + my $block = self.sicify($, '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 $ { + $after-else = self.unique-label; + self.add-code: "jmp $after-else"; + } + self.add-code: "`label $after-if"; + if $ { + $block = self.sicify($[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} diff --git a/t/compiler.t b/t/compiler.t index 51d562e..93d65d9 100644 --- a/t/compiler.t +++ b/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 { # ' diff --git a/t/runtime.t b/t/runtime.t index 6e85324..c87f25f 100644 --- a/t/runtime.t +++ b/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 {