getting the invocation syntax right was kind of tricky since my first thought,
which was that writing to $_[0] would overwrite the symtab entry for a
subroutine when the optimizer was invoked tr_optimize(\&function) turned
out to be incorrect -- it will work with globs though -- no support for
anonsubs or other alternate invocations although I'm leaving the name-based
invocation in below for your inspection.
There is obviously a lot of room for improvement especially in complex
return arguments -- I'm not sure how to do a match for balanced parentheses,
for instance, and sometimes Deparse terminates the return with a semicolon
and sometimes it doesn't.
Here's what I have just gotten working,
it does deep deep deep recursion with no stack size increase:
package Acme::TailRecursionOptimizer;
use Exporter; @EXPORT = qw/tr_optimize/;
use B::Deparse;
our $dp = B::Deparse->new(qw/ -P -q -x7/);
use Carp;
use constant DEBUG => 0;
=pod
invoke tr_optimize with a glob reference to an existing subroutine.
tr_optimize will replace the subroutine with a tail-recursive version
that clobbers @_ so shift everything out of @_ before returning
anything within your routine. complex return expressions will
probably break it at this time as the code filter is not very smart.
=cut
sub tr_optimize($){
# my $subroutine_name = shift;
# my $cp = caller();
# exists &{"$cp\::$subroutine_name"} or
# croak "arg must be function name in current package";
ref($_[0]) eq 'GLOB' or croak "arg must be glob ref, like \\*func";
my $sub_in = \&{$_[0]}; # don't shift, we're going to
# write back to $_[0]
# my $sub_in = \&{"$cp\::$subroutine_name"};
my $p = prototype($sub_in);
$p = (defined($p)? "($p)" : '');
my $deparsed = $dp->coderef2text($sub_in);
DEBUG and print "DEPARSED TO:\n$deparsed\n";
# explicitize implied return on final statement
# FIXME
# rewrite return calls as goto-sub calls
# the matching part of this could obviously be improved
$deparsed =~ s/\breturn\s+(\w+)([^;\n]*)/do{ [EMAIL PROTECTED]($2); goto
\&$1}/g;
DEBUG and print "REWROTE TO:\n$deparsed\n";
my $sub_out = eval "sub$p$deparsed";
$sub_out or die "eval: [EMAIL PROTECTED]";
DEBUG and print "EVALLED TO:\n", $dp->coderef2text($sub_out),"\n";
*{$_[0]} = $sub_out;
# *{"$cp\::$subroutine_name"} = $sub_out
};
1;
__END__
use Acme::TailRecursionOptimizer
use constant DEBUG=>1;
sub recursor2 { $x = shift; return recursor2(1+$x) if$x<21;$x };
sub recursor3 {
# print "args: @_\n";
$x = shift;
$x % 1000 or print "$x\n";
if($x < 21) {
return recursor3(1+$x+recursor2(20));
};$x
};
# tr_optimize('recursor2'); # this one could be made to work
# tr_optimize(\&recursor2); does not work as expected
# tr_optimize(*recursor2); nor this
DEBUG and print "BEFORE:\n", # ...
$Acme::TailRecursionOptimizer::dp->coderef2text(\&recursor2),"\n";
tr_optimize(\*recursor2); # this one works
DEBUG and print "AFTER:\n", $dp->coderef2text(\&recursor2),"\n";
DEBUG and print "BEFORE:\n", $dp->coderef2text(\&recursor3),"\n";
tr_optimize(\*recursor3);
DEBUG and print "AFTER:\n", $dp->coderef2text(\&recursor3),"\n";
print "Expect a return w/o OOM -- we're counting up from -100000\n";
print recursor2(-100000);
print "Expect a return w/o OOM -- we're counting up from -100000\n";
print recursor3(-100000);
--
Although efforts are under way to mitigate the problem, this message
may contain flippancy, hyperbole and/or confusing assertions. Please
reply directly to [EMAIL PROTECTED] for clarification of any points
appearing unclear, vague, cruel, frustrating, threatening, negative,
dilletantish or otherwise unprofessional before taking action based on
misintepretation or misconstruction of such points.
