Skip to content

Commit

Permalink
[Yapsi] implemented 'while' loops
Browse files Browse the repository at this point in the history 
Fairly straightforward after having done 'if' statements -- the necessary
SIC instructions turned out to be just the same ones. Also added prefix:<-->
so that it's easier to write 'while' loops that halt.
  • Loading branch information
Carl Masak committed Jul 1, 2010
1 parent cc725ab commit 4037362
Show file tree
Hide file tree
Showing 3 changed files with 72 additions and 8 deletions.
73 changes: 65 additions & 8 deletions lib/Yapsi.pm
View file
Expand Up @@ -8,11 +8,13 @@ grammar Yapsi::Perl6::Grammar {
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> }
|| <declaration> || <block>
|| <saycall> || <increment> || <decrement> }
token statement_control { <statement_control_if>
|| <statement_control_while> }
rule statement_control_if { 'if' <expression> <block>
[ 'else' <else=block> ]? }
rule statement_control_while { 'while' <expression> <block> }
token lvalue { <declaration> || <variable> || <increment> }
token value { <variable> || <literal> || <declaration> || <saycall>
|| <increment> }
Expand All @@ -23,6 +25,7 @@ grammar Yapsi::Perl6::Grammar {
rule binding { <lvalue> ':=' <expression> }
rule saycall { 'say' <expression> } # very temporary solution
rule increment { '++' <value> }
rule decrement { '--' <value> }
token block { <.ws> '{' <.ws> <statementlist> <.ws> '}' }
}

Expand Down Expand Up @@ -86,6 +89,11 @@ class Yapsi::Compiler {
&& $<statement_control><statement_control_if> -> $e {
self.find-vars($e, 'statement_control_if');
}
# RAKUDO: Autovivification
elsif $<statement_control>
&& $<statement_control><statement_control_while> -> $e {
self.find-vars($e, 'statement_control_while');
}
}

multi method find-vars(Match $/, 'expression') {
Expand All @@ -94,7 +102,7 @@ class Yapsi::Compiler {
die "Can not handle non-immediate blocks yet. Sorry. :/";
}
for <assignment binding variable declaration saycall
increment> -> $subrule {
increment decrement> -> $subrule {
if $/{$subrule} -> $e {
self.find-vars($e, $subrule);
}
Expand All @@ -113,6 +121,13 @@ class Yapsi::Compiler {
}
}

multi method find-vars(Match $/, 'statement_control_while') {
self.find-vars($<expression>, 'expression');
my $remember-block = $*current-block;
self.find-vars($<block>, 'block');
$*current-block = $remember-block;
}

multi method find-vars(Match $/, 'lvalue') {
for <variable declaration> -> $subrule {
if $/{$subrule} -> $e {
Expand All @@ -122,7 +137,7 @@ class Yapsi::Compiler {
}

multi method find-vars(Match $/, 'value') {
for <variable declaration saycall increment> -> $subrule {
for <variable declaration saycall increment decrement> -> $subrule {
if $/{$subrule} -> $e {
self.find-vars($e, $subrule);
}
Expand Down Expand Up @@ -173,6 +188,10 @@ class Yapsi::Compiler {
self.find-vars($<value>, 'value');
}

multi method find-vars(Match $/, 'decrement') {
self.find-vars($<value>, 'value');
}

multi method find-vars(Match $/, 'block') {
if $*current-block {
$*current-block ~= '_' ~ @*block-counters[*-1]++;
Expand Down Expand Up @@ -222,6 +241,10 @@ class Yapsi::Compiler {
&& $<statement_control><statement_control_if> -> $e {
return self.sicify($e, 'statement_control_if');
}
elsif $<statement_control>
&& $<statement_control><statement_control_while> -> $e {
return self.sicify($e, 'statement_control_while');
}
}

multi method sicify(Match $/, 'statement_control_if') {
Expand Down Expand Up @@ -250,25 +273,42 @@ class Yapsi::Compiler {
}
}

multi method sicify(Match $/, 'statement_control_while') {
my $before-while = self.unique-label;
my $after-while = self.unique-label;
self.add-code: "`label $before-while";
my ($register, $) = self.sicify($<expression>, 'expression');
self.add-code: "jf $register, $after-while";
my $remember-block = $*current-block;
my $block = self.sicify($<block>, 'block');
$*current-block = $remember-block;
$register = self.unique-register;
self.add-code: "$register = fetch-block '$block'";
self.add-code: "call $register";
self.add-code: "jmp $before-while";
self.add-code: "`label $after-while";
}

multi method sicify(Match $/, 'expression') {
for <variable literal declaration assignment binding saycall
increment> -> $subrule {
increment decrement> -> $subrule {
if $/{$subrule} -> $e {
return self.sicify($e, $subrule);
}
}
}

multi method sicify(Match $/, 'lvalue') {
for <variable declaration increment> -> $subrule {
for <variable declaration increment decrement> -> $subrule {
if $/{$subrule} -> $e {
return self.sicify($e, $subrule);
}
}
}

multi method sicify(Match $/, 'value') {
for <variable literal declaration saycall increment> -> $subrule {
for <variable literal declaration saycall increment decrement>
-> $subrule {
if $/{$subrule} -> $e {
return self.sicify($e, $subrule);
}
Expand Down Expand Up @@ -327,6 +367,15 @@ class Yapsi::Compiler {
return ($register, $variable);
}

multi method sicify(Match $/, 'decrement') {
my ($register, $variable) = self.sicify($<value>, 'value');
die "Can't decrement a constant"
if $variable eq '<constant>';
self.add-code: "dec $register";
self.add-code: "store $variable, $register";
return ($register, $variable);
}

multi method sicify(Match $/, 'block') {
if $*current-block {
$*current-block ~= '_' ~ @*block-counters[*-1]++;
Expand Down Expand Up @@ -470,6 +519,14 @@ class Yapsi::Runtime {
++@r[+$0];
}
}
when /^ 'dec $'(\d+) $/ {
if @r[+$0] eq 'Any()' {
@r[+$0] = -1;
}
else {
--@r[+$0];
}
}
when /^ '$'(\d+) ' = fetch-block '\'(<-[']>+)\' $/ {
@r[+$0] = ~$1;
}
Expand Down
1 change: 1 addition & 0 deletions t/compiler.t
View file
Expand Up @@ -30,6 +30,7 @@ my @programs-that-compile =
'if 1 { say 42 }',
'my $a; if $a {}',
'if my $a {} else { say 42 }',
'my $a; while $a { say $a }',
;

sub escape($string) { $string.subst("\n", "\\n", :g) }
Expand Down
6 changes: 6 additions & 0 deletions t/runtime.t
View file
Expand Up @@ -31,6 +31,12 @@ my @tests =
'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',
'my $a = 4; while --$a { say $a }',
"3\n2\n1\n", 'while loop',
'my $a; while $a { say 42 }', "", 'non-executing while loop',
# 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',
;

for @tests -> $program, $expected, $message {
Expand Down

0 comments on commit 4037362

Please sign in to comment.