File Coverage

blib/lib/Acme/Turing.pm

Criterion	Covered	Total	%
statement	85	89	95.5
branch	20	26	76.9
condition	10	16	62.5
subroutine	9	9	100.0
pod	6	6	100.0
total	130	146	89.0

package Acme::Turing;

use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
$VERSION = '0.02';

%EXPORT_TAGS = ( all => [ @EXPORT_OK ] );

#--- Create the Turing machine.
sub new {
 my $invocant = shift;
 my $class = ref($invocant) || $invocant;
 my $self = {
   steps => undef,
   spec => {},
   tape => [],
   tape_pos => 0,
   cur_state => 'START',
   @_ };

 $self->{'steps'} ||= 250;
 my $tapelen = 200;
 $self->{'tape'} = [ (" ") x $tapelen ];
 $self->{'tape_pos'} = int($tapelen / 2);

 return bless($self, $class);
}

# Add an entry to the spec hash.
sub add_spec {
 my $self = shift;
 my ($hkey, $hentry) = @_;
 Carp::croak("No entry defined") unless defined($hentry);

 $self->{'spec'}{$hkey} = $hentry;
 return;
}

# Initialize the tape.
sub init_tape {
 my $self = shift;
 my ($startpos, @symbols) = @_;
 my @Tape = @{$self->{'tape'}};
 Carp::croak("Start position $startpos is not on tape")
   if $startpos < 0 || $startpos > $#Tape;

 my $i;
 for ($i = 0; $i < @symbols ; $i++) {
   $self->{'tape'}[$startpos + $i] = $symbols[$i];
 }
 return;
}

# Step the machine to the next state.  The next state is returned.
sub step {
 my $self = shift;
# $ps = previous state.  $tp = tape position.  $ts = tape symbol.
 my $ps = $self->{'cur_state'};
 my $tp = $self->{'tape_pos'};
 my $ts = $self->{'tape'}[$tp];

# Find the instructions for this state and tape symbol.  If the tape
# symbol doesn't exist, try ANY; if that doesn't exist, fail.
 my $st_key = "$ps:$ts";
 if (! defined($self->{'spec'}{$st_key})) {
    $st_key = "$ps:ANY";
    die "Machine aborted: no action defined for state $ps/symbol $ts"
       unless defined($self->{'spec'}{$st_key});
 }
 my $actions = $self->{'spec'}{$st_key};
 my ($inst1, $next_state) = split /:/, $actions;

# Parse the instructions (P, L, R, E).
 $inst1 =~ s/\s//g;
 my @instruc = split /,/, $inst1;
 foreach (@instruc) {
    if (/^P/) {   # Write to the tape
       my $data = substr($_, 1);
       $self->{'tape'}[$tp] = $data  if $data ne "";
    } elsif (/^E/) {
       $self->{'tape'}[$tp] = ' ';
    } elsif (/^[LR]/) {
#--- Move the tape.  If we go beyond the end, make it bigger.
       my @Tape = @{$self->{'tape'}};
       $tp += (substr($_,0,1) eq 'L') ? -1 : 1;
       if ($tp < 0) {
          unshift(@Tape, (" ") x 50);
          $self->{'tape'} = [ @Tape ];
          $tp += 50;
       } elsif ($tp > @Tape - 1) {
          push(@Tape, (" ") x 50);
          $self->{'tape'} = [ @Tape ];
       } else { ; }
    } else {
       warn "Invalid instruction <$_> for state $ps";
    }
 }

 $self->{'tape_pos'} = $tp;
 $self->{'cur_state'} = $next_state;
 return $next_state;
}

# Print part of the current contents of the tape.  We print the
# symbol at the current tape position, along with L symbols to
# the left and R to the right.
sub print_tape {
 my $self = shift;
 my ($L, $R) = @_;
 $L ||= 2; $R ||= 2;  # Defaults
 my $i;
 my $tp = $self->{'tape_pos'};

 for ($i = $tp - $L; $i <= $tp + $R; $i++) {
    print "    Tape [$i] ", ($i == $tp) ? ">>> " : "    ",
      "$self->{'tape'}[$i]\n";
 }
 return;
}

# Run the machine.
sub run {
 my $self = shift;
 my ($L, $R) = @_;
 $L ||= 2; $R ||= 2;

 my $current_state = 'START';
 my $step_num = 0;
 printf "%4d  %s\n", $step_num, $current_state;
 $self->print_tape(2,2);
 while ($current_state ne 'STOP') {
    print '-' x 60, "\n";
    $current_state = $self->step();
    $step_num++;
    printf "%4d  %s\n", $step_num, $current_state;
    $self->print_tape($L,$R);
    if ($step_num == $self->{'steps'}) {
       print "------> Reached maximum number of steps.\n";
       last;
    }
 }
 print "---> Machine stopped.\n";
 return;
}

1;

__END__