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

Interesting.

> I'm surprised that all four of the sample solutions posted so far use
> a complicated-looking regex like this instead of going for 'split',
> seemed to me to be the obvious and straightforward technique.

Well, I interpreted the following :

> And let's also say that we can give symbolic names of the form /\w+/
> to the values that can be stored in the state register.

to mean that a state name that looks like !@$#* wouldn't be legal! :)  I also
wanted to make sure that the program uses legal direction names too.

Anyway, here is my solution.  I too decided on the hash as the easiest
solution.  On the whole, surprisingly easy. :)

-Tom

#!/usr/local/bin/perl -w
use strict ;
my (%state, %tape, $current_state, $the_line) ;
my ($tape_pointer, $pos, $program_file, $tape) = (0, 0, @ARGV, '') ;

$tape=~ s/^_+// ;                           ## Remove leading _ from tape
map($tape{$pos++}=$_ , split(//, $tape)) ;  ## Convert to hash for easy negative position handling

open(PROGRAM, $program_file) || die "ERROR : Unable to open $program_file : $!\n" ;
while (defined($the_line = <PROGRAM>)) {    ## Store states
    $the_line =~ s/\#.*$// ;                ## Remove comments
    $the_line =~ s/^\s+// ;                 ## Remove leading spaces
    next if $the_line =~ /^\s*$/ ;          ## Skip empty lines
    if ($the_line =~ /(\w+)\s+(\w)\s+(\w+)\s+(\w)\s+([RL])/i) {
	my ($this_state, $this_value, $next_state, $next_value, $dir) = ($1, $2, $3, $4, $5) ;
	$current_state = $this_state unless $current_state ;
	$state{$this_state}{$this_value}{next_state} = $next_state ;
	$state{$this_state}{$this_value}{next_value} = $next_value ;
	$state{$this_state}{$this_value}{dir}        = ($dir =~ /R/i) ? 1 : -1 ;
    } else {
	die "ERROR : Do not understand the following line : $the_line\n" ;
    }
}

while (defined($state{$current_state})) {    ## Run the program
    $tape{$tape_pointer} = '_' unless defined($tape{$tape_pointer}) ;
    my $current_value = $tape{$tape_pointer} ;
    my $next_value    = $tape{$tape_pointer} = $state{$current_state}{$current_value}{next_value} ;
    $tape_pointer    += $state{$current_state}{$current_value}{dir} ;
    $current_state    = $state{$current_state}{$current_value}{next_state} ;
}

## Print the result ##
undef $tape ;
foreach my $i (sort {$a <=> $b} (keys(%tape))) {
    $tape .= $tape{$i} ;
}
$tape =~ s/_+$// ;     ## Clean up leading and trailing _
$tape =~ s/^_+// ;
print "$tape\n" ;