#!/usr/bin/perl
use strict;
use warnings;
use Parse::RecDescent;

my %eval = (
   disp => \&eval_dispatch,
   term => sub { $_[0] ->  [1] },
   '+'  => sub { $_[0] + $_[1] },
   '-'  => sub { $_[0] - $_[1] },
   '*'  => sub { $_[0] * $_[1] },
   '/'  => sub { $_[0] / $_[1] },
   '%'  => sub { $_[0] % $_[1] },
);

sub eval_node {
   local *_ = \$_[0];
   return $eval{disp}->($_->[0], $_);
}

sub eval_dispatch {
    my ($op, $node) = @_;
    return $eval{$op}->($node) if $op eq 'term';
    my $x = eval_node($node->[1]);
    my $y = eval_node($node->[2]);
    return $eval{$op}->($x, $y);
}

sub treeify {
    my $t = shift @_;
    $t = [ shift @_, $t, shift @_ ] while @_;
    return $t;
}

my $grammar = <<'__END_OF_GRAMMAR__';
   build   : expr /\Z/ { $item[1] }

   # Just an alias
   expr    : sum

   # vvv lowest precedence
   sum     : <leftop: prod SUM  prod> { main::treeify(@{$item[1]}) }
   prod    : <leftop: term PROD term> { main::treeify(@{$item[1]}) }
   # ^^^ highest precedence

   term    : '(' <commit> expr ')' { $item[3] }
           | UNSIGN_INT { [ @item ] }

   # Tokens
   UNSIGN_INT   : /\d+/

   SUM          : '+' | '-'
   PROD         : '*' | '/' | '%'
__END_OF_GRAMMAR__

my $parser = Parse::RecDescent->new($grammar) or die("Bad grammar\n");
my $tree = $parser->build('11 - 6 + 4');
my $eval = eval_node($tree);
print "$eval\n";