Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re^2: eval question

by polypompholyx (Chaplain)
on Apr 17, 2007 at 07:49 UTC ( #610477=note: print w/ replies, xml ) Need Help??


in reply to Re: eval question
in thread eval question

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.


Comment on Re^2: eval question
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://610477]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (10)
As of 2014-08-27 23:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (253 votes), past polls