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

Here's my solution.  I believe it uses only Llama features.

Ronald


#!/usr/local/bin/perl -w

use strict;

my $transition_file = shift or die "Must specify transition file.\n";

my $initial_tape = shift;
$initial_tape = '_' if not defined $initial_tape;

my $i = 0;
my %tape = map {$i++ => $_} split //, $initial_tape;

my %instructions;

my $state;
my $tape_loc = 0;

open(TRANS, $transition_file) or die "Can't open '$transition_file': $!\n";
while (<TRANS>) {
  s/\#.*//;

  /\S/ or next;

  my($current_state, $current_char, $new_state, $new_char, $direction) =
    /^\s*(\w+)\s+(\w)\s+(\w+)\s+(\w)\s+([LR])\s*$/
      or die "Invalid instruction on line $..\n";

  if (exists $instructions{"$current_state $current_char"}) {
    die "$current_state $current_char redefined on line $..\n";
  }

  $state = $current_state if not defined $state;

  $instructions{"$current_state $current_char"} =
    "$new_state $new_char $direction";
}

while (my $instruction = $instructions{"$state $tape{$tape_loc}"}) {
  my($new_state, $new_char, $direction) = split ' ', $instruction;

  $state = $new_state;
  $tape{$tape_loc} = $new_char;

  if ($direction eq 'L') {
    $tape_loc--;
  } else {
    $tape_loc++;
  }

  if (not exists $tape{$tape_loc}) {
    $tape{$tape_loc} = '_';
  }
}

my $final_tape = join '', @tape{sort {$a <=> $b} keys %tape};
$final_tape =~ s/^_+//;
$final_tape =~ s/_+$//;

print "$final_tape\n";