This is probably massively over-engineered for what you want, but for what it's worth...
use strict;
use warnings;
my $expression = shift;
###################### Parse expression ##########################
use Parse::RecDescent;
my $grammar = <<'__GRAMMAR__';
expression:
<leftop: term m{(\+|\-)} term>
{
my $n = [ shift @{$item[1]} ];
while ( my ( $op, $arg ) = splice @{$item[1]}, 0, 2 )
{
if ( $op eq '+' )
{ $n = [ $n, $arg, [ 'add' ] ] }
elsif ( $op eq '-' )
{ $n = [ $n, $arg, [ 'subtract' ] ] }
}
$n;
}
term:
<leftop: factor m{(\*|\/|\%)} factor>
{
my $n = shift @{$item[1]};
while ( my ( $op, $arg ) = splice @{$item[1]}, 0, 2 )
{
if ( $op eq '*' )
{ $n = [ $n, $arg, [ 'multiply' ] ] }
elsif ( $op eq '/' )
{ $n = [ $n, $arg, [ 'divide' ] ] }
elsif ( $op eq '%' )
{ $n = [ $n, $arg, [ 'modulus' ] ] }
}
$n;
}
factor:
<leftop: primary m{(\*\*|\^)} primary>
{
my $n = [ shift @{$item[1]} ];
while ( my ( $op, $arg ) = splice @{$item[1]}, 0, 2 )
{
$n = [ $n, $arg, [ 'power' ] ];
}
$n;
}
primary:
sign(?) '(' expression ')'
{
if ( $item{'sign(?)'}[0] eq 'minus' )
{
[ $item{'expression'}, [ 'negate' ] ];
}
else
{
$item{'expression'};
}
}
|
sign(?) number
{
if ( $item{'sign(?)'}[0] eq 'minus' )
{
[ $item{'number'}, [ 'negate' ] ];
}
else
{
$item{'number'};
}
}
sign:
'+' { 'plus' }
|
'-' { 'minus' }
number: m{([+-]?((\.\d+)|(\d+\.?\d*))([Ee][+-]?\d+)?)}
{ [ 'push', $1 ] }
__GRAMMAR__
my $parser = Parse::RecDescent->new( $grammar );
my $parse_tree = $parser->expression( $expression );
unless ( defined $parse_tree )
{
die "Expression is invalid\n";
}
###################### Compile parse tree ########################
my $assembly = compile( $parse_tree );
sub compile
{
my ( $node ) = @_;
my @opcodes;
for ( my $i = 0; $i < @{ $node }; $i++ )
{
if ( UNIVERSAL::isa( $node->[ $i ], 'ARRAY' ) )
{
push @opcodes, @{ compile( $node->[ $i ] ) };
}
else
{
push @opcodes, $node;
last;
}
}
return \@opcodes;
}
####################### Execute opcodes ##########################
my @stack;
my %dispatch =
(
'add' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x + $y;
},
'subtract' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x - $y;
},
'negate' => sub
{
my ( $x ) = pop @stack; push @stack, -$x;
},
'multiply' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x * $y;
},
'divide' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x / $y;
},
'modulus' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x % $y;
},
'power' => sub
{
my ( $x, $y ) = splice @stack, -2; push @stack, $x ** $y;
},
'push' => sub
{
my ( $x ) = @_; push @stack, $x;
},
);
my $i;
for my $opcode ( @{ $assembly } )
{
my ( $function, @args ) = @{ $opcode };
$dispatch{ $function }->( @args );
}
my $result = pop @stack;
print $result;
exit 0;
You
can just compute the calculation on the fly by getting
e.g. the 'term' action to return a product or quotient, and this will be much quicker if you only intend on performing a given calculation once. The code above has the advantage of producing an intermediate form (
$assembly) that you can store, so it's quicker if the expression you are parsing is very large and will be executed repeatedly.