Brainbool interpreter

This is the reference Brainbool interpreter
 #!/usr/bin/perl -w
 
 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/</E/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/B/>[>]+<[+<]>>>>>>>>>[+]<<<<<<<<</g;
 $source =~ s/C/>>>>>>>>>+<<<<<<<<+[>+]<[<]>>>>>>>>>[+<<<<<<<<[>]+<[+<]/g;
 $source =~ s/D/>>>>>>>>>+<<<<<<<<+[>+]<[<]>>>>>>>>>]<[+<]/g;
 $source =~ s/E/<<<<<<<<</g;
 $source =~ s/F/>>>>>>>>>/g;
 $source =~ s/G/>,>,>,>,>,>,>,>,<<<<<<<</g;
 $source =~ s/H/>.>.>.>.>.>.>.>.<<<<<<<</g;
 $source =~ s/I/>>>>>>>>>+<<<<<<<<+[>+]<[<]/g;
 $source =~ s/J/>[>]+<[+<]/g;
 
 while ($source =~ s/><//g || $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);
 }
Category:Implementations