view release on metacpan or  search on metacpan

Turing.pm  view on Meta::CPAN

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) {