Viewing file:  calculator2.pl (1.31 KB) -rw-r--r--
Select action/file-type:
 (+) |  (+) |  (+) | Code (+) | Session (+) |  (+) | SDB (+) |  (+) |  (+) |  (+) |  (+) |  (+) |
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])) }
);
|