#!/usr/bin/perl
# Really stupid turing machine simulation thing.
# (c) L. Diener 2009
# Do with this code whatever you feel like doing.

use strict;
use warnings;

# Parse super duper pseudo turing machine syntax into
# something we can execute.
sub parse_machine( @ ) {
	my @input = @_;

	my %machine = ();
	$machine{'states'} = {};
	$machine{'terminal_states'} = {};
	my $cur_state = "";

	foreach( @input ) {
		my $line = $_;
		chomp( $line );

		if( $line =~ /^\+(.*)/ ) {
			# Starts with + => start state.
			$cur_state = $1;
			$machine{'states'}->{$cur_state} = {};
			$machine{'start_state'} = $1;
		}
		elsif( $line =~ /^-(.*)/ ) {
			# Starts with - => terminal state.
			$cur_state = $1;
			$machine{'terminal_states'}->{$cur_state} = 1;
		}
		elsif( $line =~ /^\s+(.*)/ ) {
			# Starts with whitespace: State change.
			my $change = $1;
			my ($symbol, $nextstate, $output, $headmove) =
				( $change =~
					/([^>]*)\s >
					\s*([^,]*)\s*,
					\s*([^,]*)\s*,
					\s*([^,]*)\s*/x
				);

			chomp( $symbol );
			chomp( $nextstate );
			chomp( $output );
			chomp( $headmove );

			$machine{'states'}->{$cur_state}->{$symbol} =
				[$nextstate, $output, $headmove];
		}
		elsif( $line =~ /^\/\/*(.*)/ ) {
			# Starts with // -> comment.
			# Do nothing.
		}
		elsif( /^\s*$/ ) {
			# Ignore empty lines.
			# Do nothing.
		}
		else {
			# A state header.
			$cur_state = $line;
			$machine{'states'}->{$cur_state} = {};
		}
	}
	
	return( %machine );
}

# Run the machine.
sub run_machine( $$$ ) {
	my %machine = %{shift()};
	my @tape = @{shift()};
	my $pos = shift();
	my $pos_disp_off = 0;

	my %terminal_states = %{$machine{'terminal_states'}};
	my %states = %{$machine{'states'}};
	my $state = $machine{'start_state'};

	while( !$terminal_states{$state} ) {
		my $this_state = $states{$state};
		if( !defined( $this_state ) ) {
			print	"Aborted with error: " .
				"Expected state $state not found.\n\n";
			exit;
		}
		my %cur_state = %{$this_state};

		my $read = defined( $tape[$pos] ) ? $tape[$pos] : '#';

		print "State: $state\n";
		print "Tape: " . join( "", @tape ) . "\n";
		print	"Character at readhead (" .
			($pos - $pos_disp_off) . "): $read\n\n";

		my $next_state = $cur_state{$read};
		if( !defined( $next_state ) ) {
			print	"Aborted with error: " .
				"No action for input $read.\n\n";
			exit;
		}

		my @state = @{$cur_state{$read}};

		$state = $state[0];
		$tape[$pos] = $state[1];
		$pos += $state[2];

		# Infinite tape, to the left.
		if( $pos == -1 ) {
			$pos = 0;
			$pos_disp_off++;
			@tape = ('#', @tape);
		}
	}

	print "Run finished.\n";
	print "Tape: " . join( "", @tape ) . "\n";
	print "Final state: $state\n\n\n";
}

# One commandline argument: Name of the machine file.
print "Reading machine file...\n";
my $machine_file = shift();
if( !defined($machine_file) or (!-e $machine_file) ) {
	print "Usage: $0 machine_file\n";
	exit;
}

# Read in and parse machine file.
open( my $MACHINE, "<$machine_file" );
my @input = <$MACHINE>;
close( $MACHINE );
my %machine = parse_machine( @input );

# Lets try this.
print "Machine read, ready for input.\n";
print "Seperate tokens for tape by ','. Whitespace is trimmed.\n\n";
while( <STDIN> ) {
	chomp( $_ );
	my @tape = split( /\s*,\s*/, $_ );
	print "New run.\n=======\n";
	print "Running with tape: " . join( "", @tape ) . "\n";
	run_machine( \%machine, \@tape, 0 );
	print "Seperate tokens for tape by ','. Whitespace is trimmed.\n\n";
}