#!/usr/bin/perl

my ($prog, $tape) = @ARGV;
@TAPE = defined($tape) ? split(//, $tape) : ('_');
$HEAD = 0;

open P, "<", $prog
 or die "Couldn't open '$prog': $!; aborting";

{
 my %motion = (L => -1, R => 1, N => 0);
 while (<P>) {
   s/\#.*$//;
   next unless /\S/;
   my ($instate, $intape, $outstate, $outtape, $motion) = split;
   $STATE = $instate unless defined $STATE;
   die "Unknown tape head motion '$motion'" unless exists $motion{$motion};
   /^\w$/ or die "Unknown tape symbol '$_'" for $intape, $outtape;
   $transition{$instate}{$intape} = [$outstate, $outtape, $motion{$motion}];
 }
 close P;
}

while (my $ttab = $transition{$STATE}) {

 if ($ENV{DEBUG}) {
   print sprintf("%5s: ", $STATE);
#    print @TAPE[0..$HEAD-1], ".$TAPE[$HEAD].",
   @TAPE[$HEAD+1..$#TAPE], "\n";
   print join("", map $_ == $HEAD   ? "<$TAPE[$_]" :
                      $_ == $HEAD+1 ? ">$TAPE[$_]" : " $TAPE[$_]",
                          0 .. $#TAPE),
         "\n";
 }

 my $inc;
 ($STATE, $TAPE[$HEAD], $inc) = @{$ttab->{$TAPE[$HEAD]}};
 $HEAD += $inc;

 # Extend the tape
 while ($HEAD < 0) {
   $HEAD++;
   unshift @TAPE, '_';
 }
 $TAPE[$HEAD] = '_' if $HEAD >= @TAPE;
}

shift @TAPE while @TAPE && $TAPE[0]  eq '_';
 pop @TAPE while @TAPE && $TAPE[-1] eq '_';

print @TAPE, "\n";
