package Loop_unroll;

use strict;
use Filter::Simple;

FILTER {

    my $unroll_limit = 10;  #max unrolling depth
    my ($var1, $cons2, $var3, $cons4, $var5, $body6);

    #This is the macro replacement pattern we're looking for...
    my $macro = 'for ($var1=$cons2;$var3<$cons4;$var5++) {$body6}';

    #run the macro snippet through B::Deparse (better way to grab output?)
    my $compiled_macro=`perl -MO=Deparse,-x9 -e'$macro'`; #screws with ', FIX ME.
    #compile the main script
    my $source = `perl -MO=Deparse,-x9 -e'$_'` if $_;     #same problem, Bad dog.

    #These are crude regex to try to match perl variables and integers
    $var1 = $var3 = $var5 = '(\$[a-zA-Z][a-zA-Z0-9]*)';
    $cons2 = $cons4 = '(\d+)';
    $body6 = '([^}]+)'; #barf, should be something nicer, no nested blocks

    #deswizzle variable order (mangled by compile)
    #variables should be guarenteed to occur only once because of side-effects
    my $i; my $reorder;
    while ($compiled_macro=~/(var1|cons2|var3|cons4|var5|body6)/g)
    {
        $reorder.="\$$1 = \$".++$i.";"; # map vars to capturing parens
    }

    $compiled_macro=~s/([|(){}\^*+?.\[\]])/\\\\$1/g; #de-meta stuff, not $ (ick)

    my $regexed_macro;
    eval '$regexed_macro=qq/'."$compiled_macro".'/'; #interpolate pattern match junk
    $source =~ s{$regexed_macro}
                {   eval $reorder;  # better method?
                   ($var1 eq $var3  and
                    $var1 eq $var5  and
                    $cons4 - $cons2 < $unroll_limit)
                    ?   "$var1 = $cons2;".("{$body6;} $var1++;") x
($cons4-$cons2)
                    : $&;  #Lazy like a fox.
                }eg;
    $_ = $source;
    #print STDERR "$source\n";
};

1;


##</code><code>##

#!/usr/bin/perl -w

use strict;
use Loop_unroll;

my $x;

for($x=0;$x<8;$x++)
{
    my $f=fact($x);
    print "factorial($x)=$f\n";
}

sub fact
{
    return(1) if ($_[0] <= 0);
    return $_[0]*fact($_[0]-1);
}


##</code><code>##


package Recur_unroll;

use strict;
use Filter::Simple;

FILTER {

    my ($name1, $body2, $name3, $param4, $body5);

    #This is the macro replacement pattern we're looking for...
    my $macro = 'sub name1 {$body2; return name3($param4); $body5}';

    #run the macro snippet through B::Deparse (better way to grab output?)
    my $compiled_macro=`perl -MO=Deparse,-x9 -e'$macro'`; #screws with ', FIXME.

    #compile the main script
    my $source = `perl -MO=Deparse,-x9 -e'$_'` if $_;     #same problem, Bad dog.

    #These are crude regex to try to match perlisms
    $name1 = '\s+([a-zA-Z][a-zA-Z0-9]*)\s+';
    $body2 = '(.*?';
    $name3 = '[^;]*?(\1';
    $param4 = '([^)]*?)';  #no parens allowed inside sub parameter list
    $body5 = ').*?)';

    #deswizzle variable order (possibly mangled by compile)
    #variables should be guarenteed to occur only once because of side-effects
    my $i; my $reorder;
    while ($compiled_macro=~/(name1|body2|name3|param4|body5)/g)
    {
        $reorder.="\$$1 = \$".++$i.";"; # map vars to capturing parens
    }
    $compiled_macro=~ s/name/\$name/g; #makes subroutine names var for interpolation
    $compiled_macro=~ s/(body\d);/$1/g; #get rid of dummy placeholder semi's
    $compiled_macro =~ s/([|(){}\^*+?.\[\]])/\\\\$1/g; #de-meta stuff, not $ (ick)

    my $regexed_macro;
    eval '$regexed_macro=qq/'."$compiled_macro".'/'; #interpolate pattern match junk
    $source =~ s{$regexed_macro}
                {   eval $reorder;
                    $name3=quotemeta($name3);
                    $body2=~s/$name3/eval{local \@_=$param4;$body2 $body5};/;
                    "sub $name1 { $body2 $body5 }";
                }esgx;
    $_ = $source;
    #print STDERR "$source\n";
};

1;