Author: fperrad
Date: Sun Jan 28 07:15:14 2007
New Revision: 16822
Modified:
trunk/languages/lua/Lua/build.pm
trunk/languages/lua/Lua/opcode.pm
trunk/languages/lua/Lua/pir.pm
trunk/languages/lua/t/function.t
Log:
[Lua]
- generate tail call
Modified: trunk/languages/lua/Lua/build.pm
==============================================================================
--- trunk/languages/lua/Lua/build.pm (original)
+++ trunk/languages/lua/Lua/build.pm Sun Jan 28 07:15:14 2007
@@ -1136,6 +1136,23 @@
sub BuildReturn {
my ( $parser, $exprs ) = @_;
+ if ( scalar @{$exprs} == 1 ) {
+ my $expr = $exprs->[0];
+ if ( scalar $expr->[1] ) {
+ my @opcodes = @{ $expr->[1] };
+ if ( scalar @opcodes and $opcodes[-1]->isa('CallOp') ) {
+ my $call = pop @opcodes;
+ my $ass = pop @opcodes;
+ my $loc = pop @opcodes;
+ push @opcodes, new TailCallDir(
+ $parser,
+ 'arg1' => $call->{arg1},
+ 'arg2' => $call->{arg2},
+ );
+ return [EMAIL PROTECTED];
+ }
+ }
+ }
my @opcodes = ();
my @returns = ();
for my $expr ( @{$exprs} ) {
Modified: trunk/languages/lua/Lua/opcode.pm
==============================================================================
--- trunk/languages/lua/Lua/opcode.pm (original)
+++ trunk/languages/lua/Lua/opcode.pm Sun Jan 28 07:15:14 2007
@@ -97,6 +97,9 @@
package CallMethOp;
use base qw(Lua::opcode);
+package TailCallDir;
+use base qw(Lua::opcode);
+
package LabelOp;
use base qw(Lua::opcode);
Modified: trunk/languages/lua/Lua/pir.pm
==============================================================================
--- trunk/languages/lua/Lua/pir.pm (original)
+++ trunk/languages/lua/Lua/pir.pm Sun Jan 28 07:15:14 2007
@@ -243,6 +243,24 @@
return;
}
+ sub visitTailCallDir {
+ my $self = shift;
+ my ($op) = @_;
+ my $FH = $self->{fh};
+ print {$FH} " .return $op->{arg1}->{symbol}(";
+ my $first = 1;
+ foreach ( @{ $op->{arg2} } ) {
+ print {$FH} ", " unless ($first);
+ print {$FH} "$_->{symbol}";
+ if ( exists $_->{pragma} and $_->{pragma} eq 'multi' ) {
+ print {$FH} " :flat";
+ }
+ $first = 0;
+ }
+ print {$FH} ")\n";
+ return;
+ }
+
sub visitBranchIfOp {
my $self = shift;
my ($op) = @_;
Modified: trunk/languages/lua/t/function.t
==============================================================================
--- trunk/languages/lua/t/function.t (original)
+++ trunk/languages/lua/t/function.t Sun Jan 28 07:15:14 2007
@@ -23,7 +23,7 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 12;
use Test::More;
language_output_is( 'lua', <<'CODE', <<'OUT', 'add' );
@@ -202,6 +202,24 @@
/no loop to break/
OUT
+language_output_is( 'lua', <<'CODE', <<'OUT', 'tail call' );
+local function foo (n)
+ print(n)
+ if n > 0 then
+ return foo(n -1)
+ end
+ return 'end', 0
+end
+
+print(foo(3))
+CODE
+3
+2
+1
+0
+end 0
+OUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
