use strict; use warnings; use Parse::RecDescent (); my $grammar = <<'__END_OF_GRAMMAR__'; { use strict; use warnings; } parse : expr /^\Z/ { $item[1] } # Just an alias expr : pow # vvv lowest precedence # pow : sum '**' pow # | sum pow : sum pow_[ $item[1] ] pow_ : '**' pow { [ $item[1], $arg[0], $item[2] ] } | { $arg[0] } # sum : sum /[+-]/ term # | term sum : term sum_[ $item[1] ] sum_ : /[+-]/ term sum_[ [ $item[1], $arg[0], $item[2] ] ] | { $arg[0] } # ^^^ highest precedence term : '(' expr ')' { $item[2] } | /\d+/ { [ @item ] } __END_OF_GRAMMAR__ my $parser = Parse::RecDescent->new($grammar) or die("Bad grammar\n"); my %eval = ( term => sub { $_[1] }, '+' => sub { eval_node($_[1]) + eval_node($_[2]) }, '-' => sub { eval_node($_[1]) - eval_node($_[2]) }, '**' => sub { eval_node($_[1]) ** eval_node($_[2]) }, ); sub eval_node { my ($node) = @_; $eval{$node->[0]}->(@$node); } foreach my $expr ( '4-5+6', # Demonstrates left-associativity '(4-5)+6', '4-(5+6)', '4**3**2', # Demonstrates right-associativity '(4**3)**2', '4**(3**2)', ) { my $expected = eval $expr; my $tree = $parser->parse($expr); my $got = eval_node($tree); print("$expr = $expected got $got\n"); }