#!/usr/bin/perl
use strict;

# Derivative and silly smiley interpretor
# Em T.
# Based on far less silly lolcode.com interpreter. Released under the BSD license 5/30/2007
# ...which was : 
# Copyright (c) 2007, Joe Drago <joedrago@gmail.com>
# All rights reserved.

use Parse::RecDescent;
use Data::Dumper;

my $grammar = q {
	
smileyfile      : smiley_program
             | { ::showerrors(); } # Allows me to handle errors my way

smiley_program  : <skip: qr/[ \t]*/> allowed_line(s) eofile
                                                             {$item[2]}
             | <error>

allowed_line : statement
             | ignored_line
			 | maths

ignored_line : comment
             | blankline

comment      : popesez anything "\n" {0} # Ignored by interpreter

statement    : /s*/ command "\n"
                                                             {$item[2]}

command		:  emote
			|  linein
			| smallemote
			| ifthen
			| declare
			| check
			| killprog 
			| whilethen
		    | maths
			

equal	: "="
			
operation : "+"
		  | "-"
		  | "/"
		  | "*"

check : "equal"
	  | "notequal"
	  | "<"
	  | ">"
	  | "contains"

maths : ":-P"  variable  operation number "\n"
                    { {LINE=>$thisline, VAR=>$item[2], CMD=>"maths", STR=>$item[3], ARGS=>$item[4] } }
#	  | ":=P" variable "=" variable operation number "\n"
#	  				{ { LINE=>$thisline, CMD=>"longmaths", STR=>$item[5], ARGS=>"$item[4],$item[6]", VAR=>$item[2] }}				
	  | ":-P" variable equal mathvariable operation mathvariable "\n"
	  				{ { LINE=>$thisline, CMD=>"longmaths", STR=>$item[5], ARGS=>"$item[4],$item[6]", VAR=>$item[2] } }				
	  


ifthen      : '^_-' variable command(?) identifier(s) "\n"
                 ignored_line(s?)
                ':-)' "\n"
                allowed_line(s)
                ':-(' "\n"
                allowed_line(s)
                '-_^'
{ {IF=>$item[2], COMMAND=>$item[3], ARGS=>$item[4], YES=>$item[9], NO=>$item[12], CMD=>$item[0]} }

whilethen 	: 'O_o' variable command(?) identifier(s) "\n"
				allowed_line(s)
			  'o_O'
{ {IF=>$item[2], COMMAND=>$item[3], ARGS=>$item[4], CMD=>$item[0], YES=>$item[6] } }

declare 	: "==>" variable "=" identifier(s) 
				{ { LINE=>$thisline, CMD=>$item[0], VAR=>$item[2], STR=>$item[4] } }

killprog	: "X-(" anything
				{  { LINE=> $thisline, CMD=> $item[0], STR=>$item[2] }   }

emote 		: ":-O" anything  
                    { {LINE=>$thisline, CMD=>$item[0], STR=>$item[2]} }

smallemote 		: ":-o" anything  
                    { {LINE=>$thisline, CMD=>$item[0], STR=>$item[2]} }


linein 		: ":-(?)" anything
					{ {LINE=>$thisline, CMD=>$item[0], VAR=>$item[2] } }

identifier   : string
             | number
             | variable

string       :  /\"[^\"]+\"/ { $item[1] }
number       : /[0-9]+/
variable     : /[a-zA-Z\(\)]+/
mathvariable     : /[a-zA-Z\(\)0-9\.]+/


eofile : /^\Z/

popesez : '<+|B-)'

anything     : /[^\n]+/
blankline  : "\n" {0}
 

};

my $filename = shift @ARGV;
if(!$filename)
{
	print "smiley.pl [filename]\n";
	exit;
}

my $parser = new Parse::RecDescent ($grammar) or die "Bad grammar!\n";

my $text = "";
{
	local $/ = undef;
	open HELLO, "< $filename" or die "cant read input\n";
	$text = <HELLO>;
	close(HELLO);
}

my $tree = $parser->smileyfile($text);
if(!defined($tree))
{
    {
        foreach (@{$parser->{errors}})
        {
            print "Line $_->[1]:$_->[0]\n";
        }
        $parser->{errors} = undef;

        undef;
    }

    exit;
}

# print Dumper($tree);


execsmile($tree);

exit;

sub getresult 
{
	my ($n,%vartable,$varname) = @_;
		$n->{'IF'}=~/\((.*)\)/;
		my $varname = $1;
		my $command=$n->{'COMMAND'}[0];
	if($command eq "equal"){
		if($vartable{$varname} eq $n->{'ARGS'}[0])	{ return 0;}
	} elsif($command eq "notequal"){
		if($vartable{$varname} eq $n->{'ARGS'}[0])	{
			return 1;
		}else { return 0; }
	} elsif ($command eq "contains"){
		if($vartable{$varname} =~/$n->{'ARGS'}[0]/) {return 0;	}
	} elsif ($command eq "<"){
		if($vartable{$varname} < $n->{'ARGS'}[0] ){
			return 0;
		}
	} elsif ($command eq ">"){
		if($vartable{$varname} > $n->{'ARGS'}[0] ){
			return 0;
		}
	} 
	return 1;
}

sub variablesubgen
{
	my ($templine,$n,%vartable) = @_;
	while ($templine=~/\((\w+)\)/){
		$templine=~/\((\w+)\)/;
		my $toreplace=$1;
		if(exists $vartable{$toreplace}){
			$templine=~s/\($toreplace\)/$vartable{$toreplace}/;
		} else { 
			print "Warning: ($toreplace) undefined on line $n->{'LINE'}\n";
			$templine=~s/\($toreplace\)//;
		}
	}
	return $templine;
}

sub variablesub
{
	my ($n,%vartable) = @_;
	my $templine;
	$templine=$n->{'STR'};
	
	while ($templine=~/\((\w+)\)/){
		$templine=~/\((\w+)\)/;
		my $toreplace=$1;
		if(exists $vartable{$toreplace}){
			$templine=~s/\($toreplace\)/$vartable{$toreplace}/;
		} else { 
			print "Warning: ($toreplace) undefined on line $n->{'LINE'}\n";
			$templine=~s/\($toreplace\)//;
		}

	} 
	return $templine;
}

sub execsmile()
{
    my($list,%vartable) = @_;
    my $ret = 0;

    for my $n (@$list)
    {
        next if(!$n);
        my $cmd = $n->{'CMD'};
		if($cmd eq "emote"){
			my $templine=variablesub($n,%vartable);
			print $templine."\n";
		} elsif ($cmd eq "smallemote"){
			my $templine=variablesub($n,%vartable);
			print $templine;
		} elsif ($cmd eq "killprog"){
			print "$n->{'STR'}\n";
			exit(0);
		} elsif ($cmd eq "linein"){
			my $line = <STDIN>;
			chomp($line);
			$n->{'VAR'}=~/\((.*)\)/;
			my $varname=$1;
			$vartable{$varname}=$line;
		} elsif ($cmd eq "declare"){
			$n->{'VAR'}=~/\((.*)\)/;
			my $varname=$1;
			if($vartable{$varname}){
				print "Warning: $n->{'VAR'} redefined on line $n->{'LINE'}\n";
			}
			my $varcontent=join(' ',@{$n->{'STR'}});
			$vartable{$varname}=$varcontent;
		} elsif($cmd eq "ifthen"){
			$n->{'IF'}=~/\((.*)\)/;
			my $varname = $1;
			my $result=getresult($n,%vartable);
			if($result == 0){
				%vartable=execsmile($n->{'YES'},%vartable);	
			} else {
				%vartable=execsmile($n->{'NO'},%vartable);	

			}	
		} elsif($cmd eq "whilethen"){
			$n->{'IF'} =~/\((.*)\)/;
			my $varname=$1;
			my $break=0;
			while($break==0){
				%vartable=execsmile($n->{'YES'},%vartable);
				if(getresult($n,%vartable)==1){
					$break=1;
				}
			}
			
		} elsif($cmd eq "maths"){
			$n->{'VAR'} =~/\((.*)\)/;
			my $varname=$1;
			my $equation;
			if($n->{'ARGS'}=~/^\d+$/){
				 $equation="$vartable{$varname} $n->{'STR'} $n->{'ARGS'}";
			} elsif($n->{'ARGS'}=~/\((.*)\)/){
				 $equation="$vartable{$varname} $n->{'STR'} $vartable{$1}";

			}
			$vartable{$varname}=eval($equation);
		} elsif ($cmd eq "longmaths"){
			$n->{'VAR'}=~/\((.*)\)/;
			my $varname = $1;
			my $equation;
			my @elements=split(',',$n->{'ARGS'});
			$equation = "$elements[0] $n->{'STR'} $elements[1] ";
			$equation=variablesubgen($equation,$n,%vartable);
			$vartable{$varname} = eval($equation);
			
		}
		
		
	}
	return %vartable;
}

sub showerrors
{
    foreach my $err (@{$parser->{errors}})
    {
        my $lineno    = $err->[1];
        my $errortext = $err->[0];
        print "Line $lineno: $errortext\n";
    }
    $parser->{errors} = undef;

    exit;
}

