'===========================================================================
' Subject: EXPRESSION EVALUATOR              Date: 07-09-97 (17:41)       
' Author:  Ian Pitt                          Code: VBDOS                  
' Origin:  IanPitt@worldnet.att.net        Packet: ALGOR.ABC
'===========================================================================
DECLARE SUB pusho (op() AS STRING * 1, operator$)
DECLARE FUNCTION popn! (ops!())
DECLARE FUNCTION popo$ (op() AS STRING * 1)
DECLARE FUNCTION peekat$ (op() AS STRING * 1)
DECLARE SUB pushn (ops!(), op!)
DECLARE SUB parse (expression$)
DECLARE FUNCTION evaluate! (expression$)

'Programmer: Ian Pitt
'Date: 7/9/1997
'Email: IanPitt@bigfoot.com
'Program Name: The Evaluator
'Purpose: Gets a mathematical expression from the user and parse it then
'         evaluates it.

'NOTE: If you need any explanation contact me at the above email address.
'      Or if you find the code particularly helpful in any way please let
'      me know as it encourages me to do more.

DEFINT A-Z
CONST true = -1, false = NOT true
'Print welcoming message and instructions
CLS
PRINT "WELCOME TO THE EVALUATOR"
PRINT : PRINT
PRINT "The following are examples of legal expressions:-"
PRINT "   2 + 2                Result is 4"
PRINT "   2 - 2                Result is 0"
PRINT "   2 * 2                Result is 4"
PRINT "   2 / 2                Result is 1"
PRINT "   2 ^ 2                Result is 4  NOTE: ie 2 raised to the power 2"
PRINT "   3+(4*(-3+2*34)+2)^2  Result is 68647"
PRINT
PRINT "You may type 'QUIT' at any time to quit the program"
PRINT


DO WHILE UCASE$(expression$) <> "QUIT"
  INPUT "Enter expression to evaluate: ", expression$
  'expression$ = "3+(4*(-3+2*34)+2)^2"
  PRINT " Expression = "; expression$
  parse expression$
  PRINT expression$; " After parsing"
  value! = evaluate(expression$)
  PRINT value!
  'expression$ = "quit"
LOOP
END

FUNCTION evaluate! (expression$)
  DIM operands!(20), operators(10) AS STRING * 1

  lexpression = LEN(expression$)
  hierarchy$ = "^*/+-()"

  operands!(0) = 0   'clears operands stack
  operators(0) = CHR$(0) 'clears operators stack
  'pushn operands!(), 0  'seeds stack with 0

  symbolstart = 1
  DO
    symbolend = INSTR(symbolstart, expression$, " ")
    IF symbolend <= 0 THEN symbolend = lexpression + 1
    symbol$ = UCASE$(MID$(expression$, symbolstart, symbolend - symbolstart))
    symbolpos = INSTR(hierarchy$, symbol$)
    IF symbolpos > 0 THEN  'this is an operator
      symbolonstack$ = peekat$(operators())
      IF INSTR(hierarchy$, symbolonstack$) > symbolpos OR symbolonstack$ = "" OR symbol$ = "(" THEN
        pusho operators(), symbol$
      ELSEIF symbol$ = ")" THEN
        DO
          symbolonstack$ = popo$(operators())
          IF INSTR("^*/+-", symbolonstack$) > 0 THEN
            op2! = popn(operands!())
            op1! = popn(operands!())
          END IF
          SELECT CASE symbolonstack$
            CASE "^": pushn operands!(), op1! ^ op2!
            CASE "*": pushn operands!(), op1! * op2!
            CASE "/": pushn operands!(), op1! / op2!
            CASE "+": pushn operands!(), op1! + op2!
            CASE "-": pushn operands!(), op1! - op2!
          END SELECT
        LOOP WHILE symbolonstack$ <> "("
      ELSE
        symbolonstack$ = popo$(operators())
        IF INSTR("^*/+-", symbolonstack$) > 0 THEN
          op2! = popn(operands!())
          op1! = popn(operands!())
        END IF
        SELECT CASE symbolonstack$
          CASE "^": pushn operands!(), op1! ^ op2!
          CASE "*": pushn operands!(), op1! * op2!
          CASE "/": pushn operands!(), op1! / op2!
          CASE "+": pushn operands!(), op1! + op2!
          CASE "-": pushn operands!(), op1! - op2!
          CASE "(": pusho operators(), symbol$
        END SELECT
        pusho operators(), symbol$
      END IF
    ELSE
      pushn operands!(), VAL(symbol$)
    END IF
    symbolstart = symbolend + 1
  LOOP WHILE symbolend < lexpression
        DO WHILE ASC(operators(0))
          symbolonstack$ = popo$(operators())
          IF INSTR("^*/+-", symbolonstack$) > 0 THEN
            op2! = popn(operands!())
            op1! = popn(operands!())
          END IF
          SELECT CASE symbolonstack$
            CASE "^": pushn operands!(), op1! ^ op2!
            CASE "*": pushn operands!(), op1! * op2!
            CASE "/": pushn operands!(), op1! / op2!
            CASE "+": pushn operands!(), op1! + op2!
            CASE "-": pushn operands!(), op1! - op2!
          END SELECT
        LOOP
  evaluate! = popn(operands!())
END FUNCTION

SUB parse (expression$)
  lexpression = LEN(expression$)
  WasOperator = true
  FOR ct = 1 TO lexpression
    ch$ = MID$(expression$, ct, 1)
    SELECT CASE ch$
      CASE " "
      CASE "("
        texpression$ = texpression$ + ch$ + " "
        WasOperator = true
      CASE ")"
        texpression$ = texpression$ + " " + ch$
        WasOperator = false
      CASE "+", "-", "*", "/", "^"
        IF NOT WasOperator THEN
          texpression$ = texpression$ + " " + ch$ + " "
        ELSE
          texpression$ = texpression$ + ch$
        END IF
        WasOperator = NOT WasOperator
      CASE ELSE
        texpression$ = texpression$ + ch$
        WasOperator = false
    END SELECT
  NEXT
  expression$ = texpression$
END SUB

FUNCTION peekat$ (op() AS STRING * 1)
  ct = ASC(op(0))
  IF ct THEN peekat$ = op(ct) ELSE peekat$ = ""
END FUNCTION

FUNCTION popn! (ops!())
  popn! = ops!(ops!(0))
  ops!(0) = ops!(0) - 1
END FUNCTION

FUNCTION popo$ (op() AS STRING * 1)
  ct = ASC(op(0))
  popo$ = op(ct)
  ct = ct - 1
  op(0) = CHR$(ct)
END FUNCTION

SUB pushn (ops!(), op!)
  ops!(0) = ops!(0) + 1
  ops!(ops!(0)) = op!
END SUB

SUB pusho (op() AS STRING * 1, operator$)
  ct = ASC(op(0))
  ct = ct + 1
  op(0) = CHR$(ct)
  op(ct) = operator$
END SUB