[SPOILER] Perl Quiz of the Week #24 (Turing Machine simulation)

Abhinav Modi <[email protected]> Fri, 17 Sep 2004 20:50:36 +0530
Newsgroups gmane.comp.lang.perl.qotw.discuss
Organization Oracle India Private Limited
Message-ID <[email protected]>
This is my3rd attempt at posting the same solution to the contest... I 
tried from a gmail account, but it didnt went through even after 12 
hours..so apologies if you see this more than once .

Also, this is my 1st QOTW attempt (and submission ) and I concur with
the previous posts that this was an easy one, which semmed hard at 1st
glance :)

I have used a string instead of an array for the tape contents ...

Any suggestions/critiques welcome.

Regards
Abhinav

--------------------
#!/usr/bin/perl
use strict;
use warnings;
#use Data::Dumper;

die "No File as input!" if (!$ARGV[0] or !-f $ARGV[0]);
die "Incorrect input string" if ($ARGV[1] and $ARGV[1] !~ /^\s*\w+\s*$/ );

my %table;
my %states;
my $maxStates = 100;
my $sr;     # The State Register
my $tape="_________";   # The Tape
my $head;   # The Head;
my $curVal;
my $newVal;
my $dir;

$tape = $ARGV[1] if ($ARGV[1]);

initTable();
$tape = '_'. $tape;
$head=1;

while(1)
{
 $curVal=substr($tape,$head,1);
 ($sr, $newVal, $dir) = @{$table{$sr}{$curVal}} if ($table{$sr}{$curVal}) or
 ( $tape =~ s/^_*(.*)$/$1/ and $tape =~ s/^(\w*?)_*$/$1/ and print
$tape."\n" and exit);
 substr($tape,$head,1,$newVal);
 $head += 1 if ($dir eq 'R');
 appendRight() if (! substr($tape,$head,1));
 $head -= 1 if ($dir eq 'L');
 appendLeft() if ($head <= 0);
}

sub initTable
{

 open(FH, "<$ARGV[0]") or die "Could not open tm file $ARGV[0] : $!";
 my @lines = <FH>;
 close (FH) or die "Could not close tm file $ARGV[0] : $!";
 my $stateCnt = 1;

 for (@lines)
 {
   chomp $_;
   (print "skipped $_ \n" && next) if (/^\s*$/ || /^\s*#.*/ );
   die "Incorrect file format: line $_"
         if (! /^\s*(\w+)\s+(\w)\s+(\w+)\s+(
\w)\s+([LR])\s*.*$/i);
   $states{$1} = $stateCnt++ if (!$states{$1});
   $sr=$states{$1}  unless($sr);
   $states{$3} = $stateCnt++ if (!$states{$3});
   $table{$states{$1}}{$2} = [$states{$3},$4,uc($5)] if (!
$table{$states{$1}}{$2}) or
           die "More than 1 rule for same state/input" ;
 }
#print Dumper(\%table);
}

sub appendLeft
{
$tape="_" x 10 . $tape;
$head += 10;
}

sub appendRight
{
$tape .= "_" x 10;
}

--------------