File Coverage

blib/lib/Acme/Brainfuck.pm

Criterion	Covered	Total	%
statement	9	9	100.0
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	12	12	100.0

#
# See POD documentation below for description, copyright and licensing info.
#
# $Id: Brainfuck.pm,v 1.5 2002/09/23 02:26:31 jaldhar Exp $
#
package Acme::Brainfuck;
use Filter::Simple;
use strict;
use warnings;

#remember to change this in the POD too.
our $VERSION = '1.1.1';

# The memory pointer and memory cells of our Turing machine.
our $p = 0;
our @m = ();

# The basic Brainfuck instructions.  Extras will be added in import().
our $ops = '+-<>,.[]';

# Whether or not we accept extra instructions.
our $verbose = 0;

# print out filtered text?
our $debug = 0;

sub import()
{
    shift;
    foreach (@_)
    {
	if (/^verbose$/)
	{
	    $ops .= '~#';
	    $verbose = 1;
	}
	if (/^debug$/)
	{
	    $debug = 1;
	}
    }
}

FILTER_ONLY code => sub
{
    my $ret = $_;
    while ($ret =~ /\s ([\Q$ops\E]+) \s/gsx)
    {
	my $code = $1;
	my $len = length($1);
	my $at = pos($ret) - ($len + 1);

	$code =~ s/^/do { /g;
	$code =~ s/$/P; }; /g;
	$code =~ s/(\++)/"P += ".length($1).";" /eg;
	$code =~ s/(\-+)/"P -= ".length($1).";" /eg;
	$code =~ s/(<+)/"\$Acme::Brainfuck::p -= ".length($1).";" /eg;
	$code =~ s/(>+)/"\$Acme::Brainfuck::p += ".length($1).";" /eg;
	$code =~ s/\./print chr P; /g;
	$code =~ s/,/P = ord getc;/g;
	$code =~ s/\[/while(P){/g;
	$code =~ s/\]/}; /g;
	if ($verbose)
	{
	    $code =~
		s/~/\$Acme::Brainfuck::p = 0;\@Acme::Brainfuck::m = (); /g;
	    $code =~
		s/\#/print STDERR sprintf\('\$p = %d \$m[\$p]= %d', \$Acme::Brainfuck::p, P\), "\\n"; /g;
	}
	$code =~ s/P/\$Acme::Brainfuck::m\[\$Acme::Brainfuck::p\]/g;
	substr($ret, $at, $len, $code);
    }
    $_ = $ret;
    print $_ if $debug;
};

1;

__END__