'===========================================================================
' Subject: EXPRESSION EVALUATOR              Date: 04-14-96 (10:55)       
' Author:  Christopher Pinder                Code: PB                     
' Origin:  comp.lang.basic.misc            Packet: ALGOR.ABC
'===========================================================================
' POWER BASIC SOURCE
' A Recusive Descent Bracket Thingy to mess with parenthesized?
' Expressions. This is a bodged version in BASIC of the code given
' in Bjarne Stroustrup's The C++ Programming Language with the
' Symbol Table Stuff stripped out.
' Very little error checking etc... but it works (Famous last words)
' Probably got more bugs than three year old yogurt but hey !

' I'm not too sure how copyright would go regarding a bit of code
' translated from a book into another language so I won't donate it
' cos I might not have the right. But I wrote this version and I don't
' care wot happens to it.

%NUMBER   = 1
%END      = 3
%PLUS     = 4
%MINUS    = 5
%MUL      = 6
%DIV      = 7
%LP       = 8
%RP       = 9

shared EVAL$
shared n$,v
shared currenttoken%

FUNCTION  GetToken%
  shared n$,v
  shared EVAL$
  shared currenttoken%
  static state%
  static curpos%
    if state% = 0 then curpos% = 1:n$="" 'yeuch !

        NUM$="0123456789."
        OPER$="+-*/=()~!@"
        WHITE$=" "+chr$(8)


'Skip whitespace
        x$=mid$(EVAL$,curpos%,1)
        l% = len(EVAL$)
        while (((instr(WHITE$,x$)) and (curpos%<l%) ))
          incr curpos%
          x$=mid$(EVAL$,curpos%,1)
        wend
        if curpos% >= l% then
            currenttoken% = %END:
            state% = 0:
            exit function
        end if

        state% = 1:
        dp% = 0:
        zz$=""
        'do the numbers first
        if(instr(NUM$,x$)>0)then
          while   ((instr(NUM$,x$)>0)  and_
                  (instr(WHITE$,x$)=0) and_
                  (instr(OPER$,x$)=0)  and_
                  (dp% < 2))
        if x$="." then incr dp%:
            if dp% = 2 then exit function:
            zz$ =zz$+ x$
            if curpos% < l% then
              incr curpos%
                x$ = mid$(EVAL$,curpos%,1)
            end if
         wend
         v = val(zz$)
         currenttoken% = %NUMBER:
         exit function:
         end if

         if instr(OPER$,x$) then
          incr curpos%
          select case x$:
              case "+":currenttoken% = %PLUS
              case "-":currenttoken% = %MINUS
              case "*":currenttoken% = %MUL
              case "/":currenttoken% = %DIV
              case "(":currenttoken% = %LP
              case ")":currenttoken% = %RP
            case else
              currenttoken% = %END:
            end select
            exit function
         end if
 end function:

function expr
     shared n$,v:
         shared currenttoken%
         local myleft
         myleft = term
         while 1
         select case currenttoken%
         case %PLUS
          GetToken%
            myleft = myleft+term:iterate
         case %MINUS
          GetToken%
            myleft = myleft-term:iterate
         case else
            expr = myleft: exit function:
         end select
         wend
end function

function term
    shared n$,v:
    local myleft
        myleft = prim
        while 1
        select case currenttoken%
        case %MUL
          GetToken%
            myleft = myleft * prim: iterate
        case %DIV
          GetToken%
            d = prim : if d = 0.00 then d = 1
            myleft = myleft / d: iterate
            case else
            term = myleft:exit function:
            end select
            wend
    end function


function prim
    shared n$,v:
  select case currenttoken%
      case %NUMBER
          prim = v
            GetToken%
        case %LP
          GetToken%
            e = expr
            if(currenttoken% <> %RP) then
              prim = 0:
                print "Mismatched Parenthesis"
                exit function
                end if
            GetToken%
            prim = e:exit function:

        case %MINUS
          GetToken%
            prim = - prim: exit function

        case %END
        prim = 0:
        end select
end function:


Function Evaluate(p$)
         shared EVAL$
         EVAL$=p$+" "    'cos we read ahead - tacky I know !
         GetToken%
         Evaluate = expr!
         end function

'----------------------------------------------------------------------
' And now - to eat the pudding !
'----------------------------------------------------------------------


cls
print "input or ! to end"
while a$ <> "!"
  a$ =""
  input a$
  ? a$ " = " ; evaluate(a$)
wend