#!/usr/bin/perl
use strict;

# Silly lolcode.com interpreter. Released under the BSD license 5/30/2007
# Copyright (c) 2007, Joe Drago <joedrago@gmail.com>
# All rights reserved.

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

my $grammar = q {
# ---------------------------------------------------------------------
# Core stuff

lolfile      : lol_program
             | { ::showerrors(); } # Allows me to handle errors my way

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

allowed_line : statement
             | ignored_line

ignored_line : comment
             | blankline

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

statement    : /s*/ IM_IN_YR "\n"
                                                             {$item[2]}
             | /s*/ IZ_ORLY "\n"
                                                             {$item[2]}
             | /s*/ command "\n"
                                                             {$item[2]}
blankline    : "\n" {0}

# ---------------------------------------------------------------------
# The big list of all commands

command      : HAI
             | IZ
             | KTHXBYE
             | I_HAS_A
             | VISIBLE
             | UP
             | BIGGER_THAN
             | SMALLER_THAN
             | GTFO

# ---------------------------------------------------------------------
# Command syntax

IZ_ORLY      : 'IZ' command 'O' "RLY?" "\n" 
                 ignored_line(s?)
                'YA RLY' "\n"
                allowed_line(s) 
                'NO WAI' "\n"
                allowed_line(s) 
                'KTHX'
{ {IZEXEC=>$item[2], YESEXEC=>$item[9], NOEXEC=>$item[12], CMD=>$item[0]} }
        
             | 'IZ' command 'O' "RLY?" "\n" 
                 ignored_line(s?)
                'YA RLY' "\n"
                allowed_line(s) 
                'KTHX'
    { {IZEXEC=>$item[2], YESEXEC=>$item[9], NOEXEC=>0, CMD=>$item[0]} }

             | 'IZ' command 'O' "RLY?" "\n" 
                 ignored_line(s?)
                'NO WAI' "\n"
                allowed_line(s) 
                'KTHX'
    { {IZEXEC=>$item[2], YESEXEC=>0, NOEXEC=>$item[9], CMD=>$item[0]} }

IM_IN_YR     : 'IM' 'IN' 'YR' variable "\n"
                allowed_line(s) 
                'KTHX'
                                { {LOOPEXEC=>$item[6], CMD=>$item[0]} }

IZ             : 'IZ' command <skip: qr//> '?' /[ \t]+/ <skip: qr/[ \t]*/> command
               { {IZEXEC=>$item[2], YESEXEC=>$item[7], CMD=>$item[0]} }

HAI          : 'HAI' anything
                    { {LINE=>$thisline, CMD=>$item[0], STR=>$item[2]} }
             | 'HAI' 
                                   { {LINE=>$thisline, CMD=>$item[0]} }

KTHXBYE      : 'KTHXBYE'
                                   { {LINE=>$thisline, CMD=>$item[0]} }

GTFO         : 'GTFO'
                                   { {LINE=>$thisline, CMD=>$item[0]} }

KTHX         : 'KTHX'
                                   { {LINE=>$thisline, CMD=>$item[0]} }

I_HAS_A      : 'I' 'HAS' 'A' variable 'ITZ' identifier
     { {VAL=>$item[6], LINE=>$thisline, CMD=>$item[0], VAR=>$item[4]} }
             | 'I' 'HAS' 'A' variable
            { {VAL=>0, LINE=>$thisline, CMD=>$item[0], VAR=>$item[4]} }

VISIBLE      : 'VISIBLE' identifier_list
                    { {LINE=>$thisline, CMD=>$item[0], VAR=>$item[2]} }
             | 'VISIBLE' identifier_list '!'
        { {NOBREAK=>1, LINE=>$thisline, CMD=>$item[0], VAR=>$item[2]} }

UP           : <skip: qr//> 'UP' /[ \t]*/ variable '!!' number
     { {INC=>$item[6], LINE=>$thisline, CMD=>$item[0], VAR=>$item[4]} }
             | <skip: qr//> 'UP' /[ \t]*/ variable '!!'
            { {INC=>1, LINE=>$thisline, CMD=>$item[0], VAR=>$item[4]} }

BIGGER_THAN  : variable 'BIGGER' 'THAN' identifier
     { {VAL=>$item[4], LINE=>$thisline, CMD=>$item[0], VAR=>$item[1]} }

SMALLER_THAN : variable 'SMALLER' 'THAN' identifier
     { {VAL=>$item[4], LINE=>$thisline, CMD=>$item[0], VAR=>$item[1]} }


# ---------------------------------------------------------------------
# Basic symbols

identifier_list : identifier 'N' identifier_list
                                            { [$item[1], @{$item[3]}] }
                | identifier 
                                                         { [$item[1]] }

identifier   : string
             | number
             | variable

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

anything     : /[^\n]+/

commentsigil : /^\^\^/
             | 'BTW'

eofile       : /^\Z/

# ---------------------------------------------------------------------
};

my $filename = shift @ARGV;
if(!$filename)
{
    print "lol.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);
}

# print "text '$text'\n";

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

        undef;
    }

    exit;
}

#print Dumper($tree);
exec_lol($tree);

exit;

# ---------------------------------------------------------------------
# Variable table and other interpreter state

my %vartable;
my $breaking = 0;

# ---------------------------------------------------------------------

sub value_from_identifier
{
    my($identifier, $line) = @_;

    if($identifier =~ /^"/)
    {
        # Its a string
        my $str = $identifier;
        $str =~ s/^\"//;
        $str =~ s/\"$//;
        return $str;
    }
    elsif($identifier =~ /^[0-9]/)
    {
        # its a raw number
        return $identifier;
    }
    else
    {
        # assume they meant a variable
        if(defined($vartable{$identifier}))
        {
            return $vartable{$identifier};
        }
        else
        {
            die "Attempted lookup of unknown variable '" . $identifier
            . "' on line $line. Aborting.\n";
        }
    }
}

sub exec_lol
{
    my($list) = @_;
    my $ret = 0;

    $breaking = 0;

    for my $n (@$list)
    {
        next if(!$n);

        my $cmd = $n->{'CMD'};

        if($cmd eq 'IM_IN_YR') # loop
        {
            while(1)
            {
                exec_lol($n->{'LOOPEXEC'});
                if($breaking)
                {
                    return $ret;
                }
            }
        }

        if($cmd eq 'GTFO')
        {
            $breaking = 1;
            return 0;
        }

        if($cmd eq 'I_HAS_A')
        {
            if(defined($vartable{$n->{'VAR'}}))
            {
                die "Double declaration of '" . $n->{'VAR'} . "' on line "
                . $n->{'LINE'} . ". Aborting.\n";
            }
            else
            {
                $vartable{$n->{'VAR'}} = $n->{'VAL'};
                $ret = $n->{'VAL'};
            }
        }

        if($cmd eq 'UP')
        {
            if(defined($vartable{$n->{'VAR'}}))
            {
                $vartable{$n->{'VAR'}} += $n->{'INC'};
                $ret = $vartable{$n->{'VAR'}};
            }
            else
            {
                die "Attempted increment of unknown variable '" . $n->{'VAR'}
                . "' on line " . $n->{'LINE'} . ". Aborting.\n";
            }
        }

        if($cmd eq 'SMALLER_THAN')
        {
            if(defined($vartable{$n->{'VAR'}}))
            {
                $ret = 0;
                if($vartable{$n->{'VAR'}} < $n->{'VAL'})
                {
                    $ret = 1;
                }
            }
            else
            {
                die "Attempted comparison of unknown variable '" . $n->{'VAR'}
                . "' on line " . $n->{'LINE'} . ". Aborting.\n";
            }
        }

        if($cmd eq 'BIGGER_THAN')
        {
            if(defined($vartable{$n->{'VAR'}}))
            {
                $ret = 0;
                if($vartable{$n->{'VAR'}} > $n->{'VAL'})
                {
                    $ret = 1;
                }
            }
            else
            {
                die "Attempted comparison of unknown variable '" . $n->{'VAR'}
                . "' on line " . $n->{'LINE'} . ". Aborting.\n";
            }
        }

        if($cmd eq 'VISIBLE')
        {
            $ret = 0;

            for my $identifier (@{$n->{'VAR'}})
            {
                print value_from_identifier($identifier, $n->{'LINE'});
            }

            unless($n->{'NOBREAK'})
            {
                print "\n";
            }
        }

        if($cmd eq 'IZ_ORLY')
        {
            $ret = 0;

            my $iz = exec_lol([$n->{'IZEXEC'}]);
            $ret = $iz;
            if($iz)
            {
                if($n->{'YESEXEC'})
                {
                    exec_lol($n->{'YESEXEC'});
                }
            }
            else
            {
                if($n->{'NOEXEC'})
                {
                    exec_lol($n->{'NOEXEC'});
                }
            }
        }

        if($cmd eq 'IZ')
        {
            $ret = 0;

            my $iz = exec_lol([$n->{'IZEXEC'}]);
            if($iz)
            {
                exec_lol([$n->{'YESEXEC'}]);
            }
        }
    }

    return $ret;
}

# ---------------------------------------------------------------------

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

    exit;
}