' Translation to Rapid-Q by William Yu

DECLARE SUB pusho (op() AS BYTE, operator$)
DECLARE FUNCTION popn# (ops#() AS DOUBLE) AS DOUBLE
DECLARE FUNCTION popo$ (op() AS BYTE) AS STRING
DECLARE FUNCTION peekat$ (op() AS BYTE) AS STRING
DECLARE SUB pushn (ops#() AS DOUBLE, op# AS DOUBLE)
DECLARE SUB parse (BYREF expression$)
DECLARE FUNCTION evaluate# (expression$) AS DOUBLE

'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 False = 0
CONST True = NOT False

'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


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"
WEND
END

FUNCTION evaluate# (expression$) AS DOUBLE
  DIM operands#(20) AS DOUBLE, operators(10) AS BYTE

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

  operands#(0) = 0   'clears operands stack
  operators(0) = 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 UNTIL 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 UNTIL symbolend >= lexpression
        WHILE 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
        WEND
  evaluate# = popn#(operands#())
END FUNCTION

SUB parse (BYREF expression$)
  lexpression = LEN(expression$)
  WasOperator = true
  texpression$ = ""
  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 BYTE) AS STRING
  ct = op(0)
  IF ct THEN peekat$ = CHR$(op(ct)) ELSE peekat$ = ""
END FUNCTION

FUNCTION popn# (ops#() AS DOUBLE) AS DOUBLE
  popn# = ops#(ops#(0))
  ops#(0) = ops#(0) - 1
END FUNCTION

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

SUB pushn (ops#() AS DOUBLE, op#)
  ops#(0) = ops#(0) + 1
  ops#(ops#(0)) = op#
END SUB

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