#! perl -slw use strict; $|++; my %ops = ( '+' => sub{ $_[ 0 ] + $_[ 1 ] }, '-' => sub{ $_[ 0 ] - $_[ 1 ] }, '*' => sub{ $_[ 0 ] * $_[ 1 ] }, '/' => sub{ $_[ 0 ] / $_[ 1 ] }, '**'=> sub{ $_[ 0 ] ** $_[ 1 ] }, ); my @presedence = ( qr[\*\*], qr[\*|/], qr[\+|-], ); my $reVar = qr[[a-z]+]; my $reConst = qr[ [+-]? (?:\d+\.)? \d+ (?: [eE] [+-]? \d+ )? ]x; my $reArg = qr[$reVar|$reConst]; my $reOps = qr[@{[ join '|', map{ quotemeta } keys %ops ]}]; my $reTokenise = qr[\s*($reArg)(?:\s*($reOps))?]; sub parseEvalExpr { my $expr = shift; if( $expr =~ m[$reOps \s+ $reArg \s+ $reOps]x ) { for my $opset ( @presedence ) { return "($expr)" if $expr =~ s[ ( $reArg \s+ $opset \s+ $reArg ) ]{($1)}x; } } my @tokens = $expr =~ m[$reTokenise]g; pop @tokens unless defined $tokens[ $#tokens ]; while( @tokens > 1 ) { ( my( $arg1, $op, $arg2 ), @tokens ) = @tokens; unshift @tokens, $ops{ $op }->( $arg1, $arg2 ); } return $tokens[ 0 ]; } while( ) { chomp; my $testResult = eval; printf "'$_' = "; warn "Unbalanced parens '$_'" and next unless tr[(][] == tr[)][]; while( m[[()\s]] ) { s[ \( ( [^()]+ ) \) ]{ parseEvalExpr( $1 ) }xe while m[[()]]; $_ = parseEvalExpr( $_ ); } print; printf STDERR "*** Discrepancy! Eval gets: %s\n", $testResult unless $_ eq $testResult; } __DATA__ 1 + 2 2 - 1 2 * 1 1 / 2 (((7 + 5) * (9 + 13)) / ((4 + 3) * (17 - 2 + 3))) 23 ** 2 1.1e10 ** -10 1 + 2 * 3 3 + 2 ** 2 ** 2 * 3