Nachdem J\u00f6rg mir ein paar Perl-B\u00fccher geliehen hatte und schon seit l\u00e4ngerer Zeit das „Hello World!“ Plakat auf unserem stillen \u00d6rtchen h\u00e4ngt, musste ich mich einfach an einen Brainfuck Interpreter versuchen.<\/p>\n
Und hier ist das Ergebnis:<\/p>\n
#!\/usr\/bin\/perl\n{\n package BF;\n use strict;\n use warnings;\n\n my @REGISTERS=('PP', 'MP', 'LOOP');\n my %OPERATORS=(\n '+' => sub {\n my ($self) = @_;\n return if $self->{_registers}{'LOOP'} < 0;\n $self->{_memory}[$self->{_registers}{'MP'}]++;\n $self->{_registers}{'PP'}++;\n },\n '-' => sub {\n my ($self) = @_;\n return if $self->{_registers}{'LOOP'} < 0;\n $self->{_memory}[$self->{_registers}{'MP'}]--;\n $self->{_registers}{'PP'}++;\n },\n '.' => sub {\n my ($self) = @_;\n return if $self->{_registers}{'LOOP'} < 0;\n push @{ $self->{_output} }, $self->{_memory}[$self->{_registers}{'MP'}];\n $self->{_registers}{'PP'}++;\n },\n '>' => sub {\n my ($self) = @_;\n return if $self->{_registers}{'LOOP'} < 0;\n $self->{_registers}{'MP'}++;\n $self->{_registers}{'PP'}++;\n },\n '<' => sub {\n my ($self) = @_;\n return if $self->{_registers}{'LOOP'} < 0;\n $self->{_registers}{'MP'}--;\n $self->{_registers}{'PP'}++;\n },\n '[' => sub {\n my ($self) = @_;\n if ($self->{_memory}[$self->{_registers}{'MP'}] > 0) {\n push @{ $self->{_stack} }, $self->{_registers}{'PP'};\n } else {\n $self->{_registers}{'LOOP'}--;\n }\n $self->{_registers}{'PP'}++;\n return;\n },\n ']' => sub {\n my ($self) = @_;\n my $loop_stacktart = pop @{ $self->{_stack} };\n if ($self->{_memory}[$self->{_registers}{'MP'}]) {\n $self->{_registers}{'PP'} = $loop_stacktart;\n } else {\n $self->{_registers}{'PP'}++;\n }\n $self->{_registers}{'LOOP'}++;\n },\n );\n\n sub new {\n my $class = shift;\n my $data = {\n _registers => { map { $_ => 0 } @REGISTERS },\n _memory => [],\n _stack => [],\n _output => [],\n };\n bless $data, $class;\n };\n\n sub run {\n my $self = shift;\n while ($self->{_registers}{PP} < $self->{_max_program_size}) {\n my $op_char = $self->{_program}[$self->{_registers}{PP}];\n my $op = $OPERATORS{$op_char};\n $op->($self);\n }\n }\n\n sub set_memory {\n my ($self, $memory) = @_;\n $self->{_program} = [ split \/\/, $memory ];\n $self->{_max_program_size} = @{ $self->{_program} };\n }\n\n sub output {\n my $self = shift;\n return join ',', @{ $self->{_output} };\n }\n\n sub char_output {\n my $self = shift;\n return join '', map { chr($_) } @{ $self->{_output} };\n }\n}\n\npackage main;\nuse strict;\nuse warnings;\n\nuse Test::More qw(no_plan);\n\nmy %test_data = (\n '++.' => '2',\n '++-.' => '1',\n '++.>+.<+.' => '2,1,3',\n '+++.[-.].' => '3,2,1,0,0',\n '++.[->++[.-]<]' => '2,2,1,2,1',\n '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.' => '72,101,108,108,111,32,87,111,114,108,100,33,10',\n);\nwhile (my ($prog, $exptected_output) = each %test_data) {\n my $bf = BF->new();\n $bf->set_memory($prog);\n $bf->run();\n is($bf->output(), $exptected_output, $prog);\n}\n\nmy $bf = BF->new();\n$bf->set_memory('++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.');\n$bf->run();\nis(\"Hello World!n\", $bf->char_output(), \"Hello World!\");\n<\/pre>\nEine tolle sinnlose Besch\u00e4ftigung.<\/p>\n