#!/usr/bin/perl -w

# Copyright (C) 2002 Jeremy Madea.  All Rights Reserved.
# This is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.


# This is a fairly lame implementation of Waduzitdo 2001, which is itself a 
# fairly lame language. I can't for the life of me figure out why anyone would 
# ever use it. I can't even figure out why I actually implemented it. *shrug*

use strict;

# Set this to a true value if you want some debugging output.
my $DEBUG = 0;


my (@SOURCE, $PC, $ACCUMULATOR, $MATCH, $MODIFIER, $OP, $DATA);

@SOURCE = map { 
    my ($M,$O,$D) = /([YN*])\s+([TAMJS])\s*:\s?(.*)/;
    $D = eval "qq($D)";
    [$M,$O,$D];
} <>;

$DEBUG && print "DEBUG: Source lines: 0 to $#SOURCE\n";

$MATCH = 0;
$PC    = -1;


sub Type { 
    print STDOUT $DATA;
}

sub Accept { 
    chomp($ACCUMULATOR = <STDIN>);
}

sub Match { 
    $MATCH = ($DATA eq $ACCUMULATOR) ? 1 : 0;
}

sub Jump { 
    my $count = 0;
    if ($DATA) {
        my $hops = $DATA;
        do {
            incrementPC();
            $DEBUG && print "mod: $MODIFIER hops:$hops count:$count\n";
        } until ($MODIFIER eq '*' and $count++ == $hops);
    } else { 
        decrementPC() until $OP eq 'A'; 
    }
}

sub Stop { 
    exit(0);
}

sub incrementPC { 
    $PC++; $DATA = "";
    die "Increment past end of source!\n" if ($PC > $#SOURCE);
    ($MODIFIER,$OP,$DATA) = @{$SOURCE[$PC]}; 
}

sub decrementPC { 
    $PC--; $DATA = "";
    die "Decrement past beginning of source!\n" if ($PC < 0);
    ($MODIFIER,$OP,$DATA) = @{$SOURCE[$PC]}; 
}

while ('Turing turns in his grave...') {

    incrementPC();
    DISPATCH: {

        $DEBUG && print "DEBUG pc:$PC match:$MATCH modifier:$MODIFIER "
                       ."op:$OP data:$DATA\n";

        if ( ($MODIFIER eq 'Y' and $MATCH)     or 
             ($MODIFIER eq 'N' and not $MATCH) or 
             ($MODIFIER eq '*') ) {
            for ($OP) { 
                /T/ and do { Type();                 last };
                /A/ and do { Accept();               last };
                /M/ and do { Match();                last };
                /J/ and do { Jump(); redo DISPATCH;  last };
                /S/ and do { Stop();                 last };
            } 
        }  else { 
            $DEBUG && print "DID NOT EXECUTE\n"; 
        }
    }
}


