1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
|
use strict;
use FindBin;
use lib "$FindBin::Bin/lib";
use Pegex;
use Runner;
my $grammar = <<'...';
expr: operand (operator operand)*
operator: /- (['+-*/^'])/
operand: num | /- '('/ expr /- ')'/
num: /- ('-'? DIGIT+)/
...
{
package Calculator;
use base 'Pegex::Tree', 'Precedence';
my $operator_precedence_table = {
'+' => {p => 1, a => 'l'},
'-' => {p => 1, a => 'l'},
'*' => {p => 2, a => 'l'},
'/' => {p => 2, a => 'l'},
'^' => {p => 3, a => 'r'},
};
sub got_expr {
my ($self, $expr) = @_;
$self->precedence_rpn($expr, $operator_precedence_table);
}
}
sub evaluate {
my ($expr) = @_;
return $expr->[0] if @$expr == 1;
my $op = pop @$expr;
my $b = get_value($expr);
my $a = get_value($expr);
return
$op eq '+' ? $a + $b :
$op eq '-' ? $a - $b :
$op eq '*' ? $a * $b :
$op eq '/' ? $a / $b :
$op eq '^' ? $a ** $b :
die "Unknown operator '$op'";
}
sub get_value {
my ($expr) = @_;
if (ref($expr->[-1]) eq 'ARRAY') {
evaluate(pop @$expr);
}
elsif ($expr->[-1] =~ m!^[-+*/^]$!) {
evaluate($expr);
}
else {
pop @$expr;
}
}
Runner->new(args => \@ARGV)->run(
sub { evaluate(pegex($grammar, 'Calculator')->parse($_[0])) }
);
|
