Brainbool interpreter

This is the reference Brainbool interpreter

use Getopt::Long; use strict; use integer; Getopt::Long::Configure ("bundling"); my $help =<<EOH; brainbool.pl - Brainbool interpreter in perl usage: perl brainbool.pl [ opts ] program cat program | perl brainbool.pl [ opts ] options: -h --help   This help -i --interpret The default mode of operation; interprete a brainbool program. When combined with --to-brainbool, will interpret the resultant program -c --to-brainbool --bb     Convert a brainfuck program to brainbool Can be combined with --interpret -n --input  Convert a stream of characters to a stream of '0's and '1's            (inputs on STDIN & outputs on STDOUT) Can be combined with --to-brainbool if brainfuck source is in           a file and input stream is on STDIN Can be combined with --interpret if brainbool source is in           a file and input stream is on STDIN Brainfuck/Brainbool source can be on STDIN if --bang is used -o --output Convert a stream of '0's and '1's to a stream of characters (inputs on STDIN & outputs on STDOUT) '0' and '1' characters may each be on their own line -b --bang   Read program on STDIN and stop at the first "!" character. Everything following the first "!" is input to the program. In --to-brainbool mode, append a "!" after the brainbool program. --nl     Separate each character by a newline Valid in all modes of operation see http://esolangs.org/wiki/Brainbool for more information on Brainbool license: Public Domain EOH my $bang; my $brainbool; my $output; my $input; my $nl; my $debug; my $source = ""; GetOptions ('help|h' => sub {             print "$help";              exit 0; },             'bang|b' => \$bang,             'to-brainbool|bb|c' => \$brainbool,             'output|o' => \$output,             'input|i' => \$input,             'nl' => \$nl,             'debug|d' => \$debug); if ($brainbool) { $source = join('', <>); $source =~ s/[^-+\[\]<>,\.]//gs; $source =~ s/-/A/g; $source =~ s/\+/B/g; $source =~ s/\[/C/g; $source =~ s/\]/D/g; $source =~ s//F/g; $source =~ s/,/G/g; $source =~ s/\./H/g; while ($source =~ s/AB//g || $source =~ s/BA//g ||         $source =~ s/EF//g || $source =~ s/FE//g ||          $source =~ s/AA/IA/g || $source =~ s/AI/IA/g ||          $source =~ s/BB/JB/g || $source =~ s/BJ/JB/g) { } $source =~ s/A/>>>>>>>>>+<<<<<<<<+[>+]<[<]>>>>>>>>>[+]<<<<<<<<[>]+<[+<]>>>>>>>>>[+]<<<<<<<<>>>>>>>>+<<<<<<<<+[>+]<[<]>>>>>>>>>[+<<<<<<<<[>]+<[+<]/g; $source =~ s/D/>>>>>>>>>+<<<<<<<<+[>+]<[<]>>>>>>>>>]<[+<]/g; $source =~ s/E/<<<<<<<<>>>>>>>>/g; $source =~ s/G/>,>,>,>,>,>,>,>,<<<<<<<.>.>.>.>.>.>.>.<<<<<<<>>>>>>>>+<<<<<<<<+[>+]<[<]/g; $source =~ s/J/>[>]+<[+<]/g; while ($source =~ s/>//g) { } $source .= $bang ? "!" : "";  if ($input) { my $ch; while (defined($ch = getc)) { $source .= reverse(sprintf('%08b', ord($ch))); }  }   print join(($nl ? "\n" : ""), split(//, $source), ""); exit 0; } elsif ($output) { my $bits = ""; while (<>) { s/\n//gs; $bits .= $_; while (length($bits) >= 8) { print chr(eval("0b". reverse(substr($bits, 0, 8, "")))); }  }   exit 0 } elsif ($input) { my $sep = $nl ? "\n" : ""; while (<>) { while (length($_) >= 1) { print join($sep, split(//, reverse(sprintf('%08b', ord(substr($_, 0, 1, ""))))), ""); }  }   exit 0 } if ($bang) { my $ch; while (($ch = getc) ne "!") { die "no \"!\" ever found on STDIN\n" unless defined $ch; $source .= $ch; } } else { $source = join('', <>); } my @bracket; my @tape = (0); my $t_ptr = 0; my @prog; while (length($source)) { my $ch = substr($source, 0, 1, ""); if ($ch eq ">") { push @prog, sub { $t_ptr++; $tape[$t_ptr] = 0 if $t_ptr > $#tape; }; } elsif ($ch eq "<") { push @prog, sub { $t_ptr--; }; } elsif ($ch eq "+") { push @prog, sub { $tape[$t_ptr] = !$tape[$t_ptr]; }; } elsif ($ch eq ",") { push @prog, sub { my $ch = getc; $tape[$t_ptr] = defined($ch) ? $ch + 0 : 0; }; } elsif ($ch eq ".") { push @prog, $debug ? sub { print($tape[$t_ptr] ? "1\n" : "0\n"); } : sub { print($tape[$t_ptr] ? "1" : "0"); }; } elsif ($ch eq "[") { push @bracket, $#prog+1; } elsif ($ch eq "]") { do { my @p2 = splice @prog, pop(@bracket); push @prog, sub { @prog = (@p2, shift, @prog) if $tape[$t_ptr] }; };  } } while (scalar @prog) { print join(" ", map { $_ ? 1 : 0 } @tape[0 .. $t_ptr]), "@", join(" ", map { $_ ? 1 : 0 } @tape[$t_ptr+1 .. $#tape]), "\n" if $debug; my $i = shift @prog; $i->($i); }
 * 1) !/usr/bin/perl -w