If executed from left-to-right, 4 - 5 + 6 = (4 - 5) + 6 = 5 If executed from right-to-left, 4 - 5 + 6 = 4 - (5 + 6) = -7 #### If executed from left-to-right, 4 ** 3 ** 2 = (4 ** 3) ** 2 = 4096 If executed from right-to-left, 4 ** 3 ** 2 = 4 ** (3 ** 2) = 262144 #### sum : sum /[+-]/ NUM | NUM #### pow : NUM '**' pow | NUM #### sum : sum '+' NUM { $item[1] + $item[3] } | sum '-' NUM { $item[1] - $item[3] } | NUM { $item[1] } #### pow : NUM '**' sum { $item[1] ** $item[3] } | NUM { $item[1] } #### sum : sum /[+-]/ NUM { [ @item[2,1,3] ] } | NUM { [ $item[1] ] } #### pow : NUM '**' pow { [ @item[2,1,3] ] } | NUM { [ $item[1] ] } #### sum : NUM sum_ { [ $item[1], @{$item[2]} ] } sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] } | { [] } #### { sub eval_sum { my $acc = shift(@_); while (@_) { my $op = shift(@_); if ($op eq '+') { $acc += shift(@_); } elsif ($op eq '-') { $acc -= shift(@_); } } return $acc; } } sum : NUM sum_ { eval_sum($item[1], @{$item[2]}) } sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] } | { [] } #### { sub treeify { my $t = shift(@_); $t = [ shift(@_), $t, shift(@_) ] while @_; return $t; } } sum : NUM sum_ { treeify($item[1], @{$item[2]}) } sum_ : /[+-]/ NUM sum_ { [ $item[1], $item[2], @{$item[3]} ] } | { [] } #### { sub eval_sum { my $acc = shift(@_); while (@_) { my $op = shift(@_); if ($op eq '+') { $acc += shift(@_); } elsif ($op eq '-') { $acc -= shift(@_); } } return $acc; } } sum : { eval_sum(@{$item[1]}) } #### { sub treeify { my $t = shift(@_); $t = [ shift(@_), $t, shift(@_) ] while @_; return $t; } } sum : { treeify(@{$item[1]}) } #### rule1: token rule2 rule2: token rule3 rule3: token #### sum : NUM sum_[ $item[1] ] sum_ : '+' NUM sum_[ $arg[0] + $item[2] ] | '-' NUM sum_[ $arg[0] - $item[2] ] | { $arg[0] } #### sum : NUM sum_[ $item[1] ] sum_ : '+' NUM sum_[ [ $item[1], $arg[0], $item[2] ] ] | '-' NUM sum_[ [ $item[1], $arg[0], $item[2] ] ] | { $arg[0] } #### pow : NUM '**' pow | NUM #### pow : NUM pow_ pow_ : '**' pow | #### { sub eval_pow { my $acc = pop(@_); while (@_) { my $op = pop(@_); $acc = pop(@_) ** $acc; } return $acc; } } pow : NUM pow_ { eval_pow($item[1], @{$item[2]}) } pow_ : '**' NUM pow_ { [ $item[1], $item[2], @{$item[3]} ] } | { [] } #### { sub treeify_r { my $t = pop; $t = [ pop, pop, $t ] while @_; return $t; } } pow : NUM pow_ { treeify_r($item[1], @{$item[2]}) } pow_ : '**' NUM pow_ { [ $item[1], $item[2], @{$item[3]} ] } | { [] } #### { sub eval_pow { my $acc = pop(@_); while (@_) { my $op = pop(@_); $acc = pop(@_) ** $acc; } return $acc; } } pow : { eval_pow(@{$item[1]}) } #### { sub treeify_r { my $t = pop; $t = [ pop, pop, $t ] while @_; return $t; } } pow : { treeify_r(@{$item[1]}) } #### pow : NUM '**' pow { $item[1] ** $item[3] } | NUM { $item[1] } #### pow : NUM pow_ pow_ : '**' pow { <> ** $item[2] } | { <> } #### pow : NUM pow_[ $item[1] ] pow_ : '**' pow { $arg[0] ** $item[2] } | { $arg[0] } #### pow : NUM pow_[ $item[1] ] pow_ : '**' pow { [ $item[1], $arg[0], $item[2] ] } | { $arg[0] } #### Demonstrates left-associativity 4-5+6 = 5 got 5 (4-5)+6 = 5 got 5 4-(5+6) = -7 got -7 Demonstrates right-associativity 4**3**2 = 262144 got 262144 (4**3)**2 = 4096 got 4096 4**(3**2) = 262144 got 262144 #### 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 { $arg[0] ** $item[2] } | { $arg[0] } # sum : sum /[+-]/ term # | term sum : term sum_[ $item[1] ] sum_ : '+' term sum_[ $arg[0] + $item[2] ] | '-' term sum_[ $arg[0] - $item[2] ] | { $arg[0] } # ^^^ highest precedence term : '(' expr ')' { $item[2] } | /\d+/ __END_OF_GRAMMAR__ my $parser = Parse::RecDescent->new($grammar) or die("Bad grammar\n"); 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 $got = $parser->parse($expr); print("$expr = $expected got $got\n"); } #### 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"); }