#!/usr/bin/perl -w

use strict;
use Parse::RecDescent;

my @STACK;

use MooX::Struct 0.007 -retain,
	Program => [
		qw( @instructions ),
		evaluate => sub {
			my $self = shift;
			my $result;
			foreach my $instruction (@{ $self->instructions }) {
				$result = $instruction->evaluate;
			}
			return $result;
		},
		to_perl => sub {
			my $self = shift;
			join "\n", map { sprintf('%s;', $_->to_perl) } @{ $self->instructions };
		},
		to_javascript => sub {
			my $self = shift;
			join "\n", map { sprintf('%s;', $_->to_javascript) } @{ $self->instructions };
		},
	],
	PrintStatement => [
		qw( $expression ),
		evaluate => sub {
			my $self = shift;
			print STDOUT $self->expression->evaluate, "\n";
		},
		to_perl => sub {
			my $self = shift;
			sprintf('print STDOUT %s, "\n"', $self->expression->to_perl);
		},
		to_javascript => sub {
			my $self = shift;
			sprintf('window.alert(%s)', $self->expression->to_javascript);
		},
	],
	Assignment => [
		qw( $variable $expression ),
		evaluate => sub {
			my $self = shift;
			$self->variable->evaluate = $self->expression->evaluate;
		},
		to_perl => sub {
			my $self = shift;
			sprintf('%s = %s', $self->variable->to_perl, $self->expression->to_perl);
		},
		to_javascript => sub {
			my $self = shift;
			sprintf('%s = %s', $self->variable->to_javascript, $self->expression->to_javascript);
		},
	],
	Expression => [
		qw( $lhs $op $rhs ),
		evaluate => sub {
			my $self = shift;
			my $op   = $self->op;
			my $sub  = eval qq{ sub { \$_[0] $op \$_[1] } };
			$sub->($self->lhs->evaluate, $self->rhs->evaluate);
		},
		to_perl => sub {
			my $self = shift;
			sprintf('(%s %s %s)', $self->lhs->to_perl, $self->op, $self->rhs->to_perl);
		},
		to_javascript => sub {
			my $self = shift;
			my $op   = $self->op;
			$op = '+' if $op eq '.';
			sprintf('(%s %s %s)', $self->lhs->to_javascript, $op, $self->rhs->to_javascript);
		},
	],
	Literal => [
		qw( $value ),
		evaluate => sub { $_[0]->value },
	],
	Integer  => [
		-extends => ['Literal'],
		to_perl => sub {
			my $self = shift;
			sprintf('%s', $self->value);
		},
		to_javascript => sub {
			my $self = shift;
			sprintf('%s', $self->value);
		},
	],
	String   => [
		-extends => ['Literal'],
		to_perl => sub {
			my $self = shift;
			sprintf("'%s'", $self->value);
		},
		to_javascript => sub {
			my $self = shift;
			sprintf("'%s'", $self->value);
		},
	],
	Variable => [
		qw( $name ),
		evaluate => sub :lvalue { $STACK[-1]{ $_[0]->name } },
		to_perl => sub {
			my $self = shift;
			sprintf('$%s', $self->name);
		},
		to_javascript => sub {
			my $self = shift;
			sprintf('%s', $self->name);
		},
	],
;


$::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error
$::RD_WARN   = 1; # Enable warnings. This will warn on unused rules &c.
$::RD_HINT   = 1; # Give out hints to help fix problems.
# $::RD_TRACE  = 1; # Trace the whole thing

my $parser = Parse::RecDescent->new(<<'_EOGRAMMAR_');

# Terminals (macros that can't expand further)
#

startrule : instruction(s /;/) 
          { main::Program[ $item[1] ] }

instruction : print_instruction
            { $item[1] }
            | assign_instruction
            { $item[1] }
            | expression
            { $item[1] }

print_instruction  : /print/i expression 
                   { main::PrintStatement[ $item{expression} ] }
assign_instruction : VARIABLE "=" expression
                   { main::Assignment[ $item{VARIABLE}, $item{expression} ] }

expression : STRING '+' expression
           { main::Expression[ $item{STRING}, '.', $item{expression} ] }
           | term OP expression
           { main::Expression[ $item{term}, $item{OP}, $item{expression} ] }
           | term
           { $item[1] }

term: '(' expression ')' 
      { $item[2] }
      | INTEGER
      | STRING
      | VARIABLE

OP       : m([*/%+-])
INTEGER  : /[+-]?[0-9]*\.?[0-9]+/     # Signed integers
         { main::Integer[ $item[1] ] }
VARIABLE : /\w[a-z0-9_]*/i # Variable
         { main::Variable[ $item[1] ] }
STRING   : /'.*?'/
         { my $s = $item[0]; $s =~ s/^'(.*)'$/$1/; main::String[ $s ] }

_EOGRAMMAR_


my $parsed = $parser->startrule(<<'SCRIPT');
x = (2+3)/(2*(7+3));
print x;
print 'Hello World';
SCRIPT

@STACK = {};

print $parsed->to_perl, "\n---\n";
print $parsed->to_javascript, "\n---\n";
$parsed->evaluate;