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;