Link to YaccHowTo

#!/usr/local/bin/perl4
@rem = '
@echo off
perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9
goto endofperl
';
#
# Another way to evaluate infix expressions...(with precedence)
#   Tokenize input, parse expressions, use priority table.
#   Expect input to basically alternate between numbers and operators.
#   Use $last_was_op flag to handle ()'s and unary minus, which
#   will violate the alternation rule, such as 2*-3 and (1+2)*3.
#   Use two stacks, one for data (@d) and one for operators (@o).
#   Simply push numbers onto data stack.
#   Push operators onto operator stack, but check that no higher
#   priority operations are "pending", i.e. on the stack.  If they
#   are, pop them off and use the data on the top of the data stack.
#   Do some trickery with ()'s to make them evaluate innards first.
#   Make = the lowest priority to make sure whole expression is evaluated.
# (C) Copyright 12Dec96 Robert Dowling www.uman.com
#
$DOS = -e '/autoexec.bat';

$D = 0;      # Set this to 1 to get debugging info

$OPS = "^[-+*\\/^=()]\$";   # Regular expression for operators

# Each operation and it's precedence, bigger means tighter
%priority = (
   '=',   0,
   ')',   5,
   '+',   10,   '-',   10,
   '*',   20,   '/',   20,
   '^',   30,   
   'U-',   40,
   '(',   50,
);

# What to do when we find an operation
%code = (
   '+','$b=pop(@d); $a=pop(@d); push(@d, $a+$b);',
   '-','$b=pop(@d); $a=pop(@d); push(@d, $a-$b);',
   '*','$b=pop(@d); $a=pop(@d); push(@d, $a*$b);',
   '/','$b=pop(@d); $a=pop(@d); push(@d, $a/$b);',
   '^','$b=pop(@d); $a=pop(@d); push(@d, $a**$b);',
   ')','',
   'U-','push (@d, -pop(@d));'
);

while ($i=<>)
{
   # Concatenate input until line ending in =
   chop ($i);
   $_ .= $i;
   next unless /=$/;

   # Split on operations [+-*/^=()] and prune null elements
   undef (@i);
   for (split (/([-+*\/^=()])/))   { push (@i, $_) if $_; }

   #print join(',  ', @i),"\n";

   # Join scientific 1e + 3 notation back together into 1e+3
   undef (@_);
   while ($_ = shift (@i))
   {
      if (/[Ee]$/ && $i[0]=~/^[-+]$/) {
         $_ .= shift (@i);
         $_ .= shift (@i);
      }
      push (@_, $_);
   }
   #print join(',  ', @_),"\n";

   # Process
   #print join(',  ', @_),"\n";
   print "Exp=", &addition (@_), "\n";

   $_='';
}

# Just return 1 if token is an operator
sub is_op
{
   local ($_) = @_;
   /$OPS/o;
}

# Why I called this addition, I don't know.
# It does all the work.  Given an array of tokens, like '2','+','3','='
# compute the expression and return it.
sub addition
{
   local (@i, @o, @d, $_, $a, $b, $d, $o, $last_was_op) = @_;

   # Pretend the last token input was an operation
   $last_was_op=1;

   # Get a new token
   while ($_ = shift(@i))
   {
      if ($D) {
       print "Input=$_=$priority{$_}\t";
       print "i=", join(",", @i), "\t";
       print "o=", join(",", @o), "\t";
       print "d=", join(",", @d), "\n"; }
      if (&is_op ($_))
      {
         # About to push on another operator, so check if
         # we should pop last one off and execute it.
         # Execute higher precedence operations.
         # The last_was_op stuff if to handle parenthesis,
         # like (2+2)*2, where ) and * are next to each other
         while (scalar(@o) &&
            $priority{$_} <= $priority{$o[$#o]} &&
            !$last_was_op)
         {
            # Fetch a pending operation on stack
            $o = pop (@o);

            # Execute using @d stack and leaving
            # answer back on @d stack
            $d = $code{$o};
            eval $d;

            # Just debug
            if ($D) {
             print "...eval $d;";
             print "--$@--";
             print "...o=", join(",", @o), "\t";
             print "d=", join(",", @d), "\n";
            }

            # The precedence of ) is low to force
            # everything inside ()'s to execute,
            last if $o =~ /\)/;
         }

         # Special magic to make ()'s work.  Don't push '('.
         # Push a ')' instead because it has low precedence
         # and will force everything inside to execute first.
         # But note that ( has highest precedence.
         if (/\(/)
         {
            $last_was_op = 1;
            push (@o, ')');
            # Get out of here.  Read another token
            next;
         }
         if (/\)/)
         {
            # Make (#+#) look like #, so last was not op.
            $last_was_op = 0;
            # Read another token
            next;
         }

         # Special case unary - by renaming it
         # Unary minus always appears just after an operator
         if ($last_was_op)
         {
            $_ = "U$_";
         }

         # If we got here, we have finished processing other
         # operators (and parenthesis)
         # Just push onto operator stack
         # And remember we just read an operator
         $last_was_op = 1;
         push (@o, $_);
      }
      else   # Else token is a number
      {
         # Push number onto data stack
         $last_was_op = 0;
         push (@d, $_);
      }
   }

   # Return top of data stack as answer
   0+pop (@d);
}

#
#
#
__END__
:endofperl

-- JohnCoe - 04 Apr 2004

This is almost identical to the infix expression parser in the FormQueryPlugin, and like that parser duplicates the function of the "eval it and pray" parser in the SpreadSheetPlugin.

-- CrawfordCurrie - 04 Apr 2004

Well, what about the performance of the regular expression based "eval it and pray" parser compared to a YACC?

-- PeterThoeny - 06 Apr 2004

I'd bet my money on a YACC based parser every time. Wanna race? But neither the parser presented above, nor the one in the FQP, are YACC parsers - YACC parsers are table-driven parsers generated by a parser generator and coded in C. Comparative performance of these three parsers? Dunno. At a guess, I would think the eval-and-pray would be several times faster, because it delegates the parsing function to perl i.e. it doesn't actually parse anything. On the other hand, it isn't possible to suicide the twiki installation using the coded parser! -- CC

Actually it isn't possible to kill the sevrer using a $EVAL - I just tried However (every cloud has to have a silver lining!) $EVAL only supports simple arithmetic operations on numbers, while the parser approach can support many more infix operators and even variables and functions, which can never be done in the eval-and-pray approach because of the security risk. Oh, and the eval-and-pray approach is about 10X faster. -- CC

I've used CPAN:Parse::RecDescent with good results, but it's quite slow so it wouldn't really work for TWiki. Of course, using a high level but efficiently compiled language like OCaml would help (See Donkin:OCamlLanguage for more about this). Recovery from errors would need to be quite good - the current TWiki parser has the merit of producing some output even if the input is quite wrong.

-- RichardDonkin - 06 Apr 2004