This is a recursive descent parser expression evaluator able to fix the math for you. It's based on PureBasic's
built in math of course, with a few differences: == is equal to, & is AND, | is OR.
Code: Select all
;String math expression evaluator, utopiomania 20070211
;PureBasic 4.00
Declare.f eval(str.s)
Declare.f level1()
Declare.f level2()
Declare.f level3()
Declare.f level4()
Declare.f level5()
Declare.f level6()
Declare.f level7()
Declare.f level8()
Declare.f level9()
Declare.f primitive()
Declare.f calc(op.s, num1.f, num2.f)
Declare.f unary(op.s, num.f)
Declare rewind()
Declare.f letVar(var.s, num.f)
Declare.f getVar()
Declare.f clearVars()
Declare gettoken()
Declare isFunc(str.s)
Declare isCommand(str.s)
Declare isMinus(str.s)
Declare isParenth(str.s)
Declare isDelim(str.s)
Declare notDelim(str.s)
Declare isAlpha(str.s)
Declare isDigit(str.s)
Declare isSpace(str.s)
Declare notVailidop(op.s)
Declare isErr(str.s)
;holds the expression to be evaluated:
Global expr.s
;Points to the next token in expression:
Global progr.l
;holds the token:
Global token.s
;token type:
Global ttype.l
#MAXVARS = 1000
Global Dim varNames.s(#MAXVARS)
Global Dim vars.f(#MAXVARS)
#MAXFNC = 11
Global Dim fnc.s(#MAXFNC)
fnc(0) = "ACOS": fnc(1) = "ASIN": fnc(2) = "ATAN": fnc(3) = "ABS"
fnc(4) = "COS": fnc(5) = "INT": fnc(6) = "LOG": fnc(7) = "LOG10"
fnc(8) = "SIN": fnc(9) = "SQR": fnc(10) = "TAN"
#MAXCMD = 1
Global Dim cmd.s(#MAXCMD)
cmd(0) = "CLEAR"
;token types:
#DELIM = 1
#VARIABLE = 2
#NUMBER = 3
#FUNCTION = 4
#COMMAND = 5
Global error.s
Global ERR_SYNTAX.s, ERR_PARENTH.s, ERR_NOEXPR.s, ERR_DIVZERO.s
ERR_SYNTAX = "SYNTAX ERROR"
ERR_PARENTH = "UNBALANCED PARENTHESES"
ERR_NOEXPR = "NO EXPRESSION"
ERR_DIVZERO = "DIVISION BY ZERO"
Procedure.f eval(str.s)
;entry point into parser
progr = 1
error = ""
expr = UCase(str)
gettoken()
If token = ""
error = ERR_NOEXPR
EndIf
isErr(expr)
If Len(error)
ProcedureReturn #False
EndIf
ProcedureReturn level1()
EndProcedure
Procedure.f level1()
;assignment statement/command
typ.l
tok.s
If ttype= #VARIABLE
;Save old token
tok = token
typ = ttype
gettoken()
If token = "="
;assignment
gettoken()
ProcedureReturn letVar(tok, level2())
Else
;Restore
Rewind()
token = tok
ttype = Typ
EndIf
ElseIf ttype = #COMMAND
If token = "CLEAR"
;Restore
rewind()
token = tok
ttype = typ
clearVars()
ProcedureReturn 0
EndIf
EndIf
ProcedureReturn level2()
EndProcedure
Procedure.f level2()
;logical and/or
result.f = level3()
op.s = token
While (op = "&") Or (op = "|")
gettoken()
result = calc(op, result, level3())
op = token
Wend
ProcedureReturn result
EndProcedure
Procedure.f level3()
;conditional operators
result.f = level4()
op.s = token
While (op = "<") Or (op = ">") Or (op = "<>") Or (op = "<=") Or (op = ">=") Or (op = "==")
gettoken()
result = calc(op, result, level4())
op = token
Wend
ProcedureReturn result
EndProcedure
Procedure.f level4()
;add or subtract two terms
result.f = level5()
op.s = token
While (op = "+") Or (op = "-")
gettoken()
result = calc(op, result, level5())
op = token
Wend
ProcedureReturn result
EndProcedure
Procedure.f level5()
;multiply, divide
result.f = level6()
op.s = token
While (op = "*") Or (op = "/")
gettoken()
result = calc(op, result, level6())
op = token
Wend
ProcedureReturn result
EndProcedure
Procedure.f level6()
;Exponent
result.f = level7()
If token = "^"
gettoken()
result = calc("^", result, level7())
EndIf
ProcedureReturn result
EndProcedure
Procedure.f level7()
;unary plus or minus
op.s = ""
If (ttype = #DELIM) And ((token = "+") Or (token = "-"))
op = token
gettoken()
EndIf
result.f = level8()
If Len(op)
result = Unary(op, result)
EndIf
ProcedureReturn result
EndProcedure
Procedure.f level8()
;functions
op.s = ""
If ttype = #FUNCTION
op = token
gettoken()
EndIf
result.f = level9()
If Len(op)
result = calc(op, result, 0)
EndIf
ProcedureReturn result
EndProcedure
Procedure.f level9()
;parenthesized expression
result.f
If (ttype = #DELIM) And (token = "(")
gettoken()
result = level1()
gettoken()
Else
result = primitive()
EndIf
ProcedureReturn result
EndProcedure
Procedure.f primitive()
;find value of number or variable
result.f
Select ttype
Case #VARIABLE
result = getVar()
gettoken()
Case #NUMBER
result = ValF(token)
gettoken()
Default
error = ERR_SYNTAX
EndSelect
ProcedureReturn result
EndProcedure
Procedure.f calc(op.s, num1.f, num2.f)
result.f
Select op
Case "&"
result = Bool(num1 And num2)
Case "|"
result = Bool(num1 Or num2)
Case "<"
If num1 < num2
result = 1
EndIf
Case ">"
If num1 > num2
result = 1
EndIf
Case "<>"
If num1 <> num2
result = 1
EndIf
Case "<="
If num1 <= num2
result = 1
EndIf
Case ">="
If num1 >= num2
result = 1
EndIf
Case "=="
If num1 = num2
result = 1
EndIf
Case "-"
result = num1 - num2
Case "+"
result = num1 + num2
Case "*"
result = num1 * num2
Case "/"
If num2 <> 0
result = num1 / num2
Else
error = ERR_DIVZERO
result = 0
EndIf
Case "^"
result = Pow(num1, num2)
Case "ACOS"
result = ACos(num1)
Case "ASIN"
result = ASin(num1)
Case "ATAN"
result = ATan(num1)
Case "ABS"
result = Abs(num1)
Case "COS"
result = Cos(num1)
Case "INT"
result = Int(num1)
Case "LOG"
result = Log(num1)
Case "LOG10"
result = Log10(num1)
Case "SIN"
result = Sin(num1)
Case "SQR"
result = Sqr(num1)
Case "TAN"
result = Tan(num1)
EndSelect
ProcedureReturn result
EndProcedure
Procedure.f unary(op.s, num.f)
;unary minus
If op = "-"
ProcedureReturn -num
EndIf
ProcedureReturn num
EndProcedure
Procedure rewind()
;back up to the previous token
progr = progr - Len(token)
EndProcedure
Procedure.f letVar(var.s, num.f)
;assign a value to a variable
i = 0
While Len(varNames(i))
If var = varNames(i)
vars(i) = num
ProcedureReturn num
EndIf
i + 1
Wend
varNames(i) = var
vars(i) = num
ProcedureReturn num
EndProcedure
Procedure.f getVar()
;find value of a variable
i = 0
While Len(varNames(i))
If token = varNames(i)
ProcedureReturn vars(i)
EndIf
i + 1
Wend
letVar(token, 0)
ProcedureReturn getVar()
EndProcedure
Procedure.f clearVars()
;clears variable names and values:
For i = 0 To #MAXVARS - 1
vars(i) = 0
varNames(i) = ""
Next
EndProcedure
Procedure getToken()
;get the next token/token type in expression
ttype = 0
token = ""
If progr > Len(expr)
ProcedureReturn
EndIf
While isSpace(Mid(expr, progr, 1))
Progr + 1
Wend
Select #True
Case isMinus(Mid(expr, progr, 1))
ttype = #DELIM
token = Mid(expr, progr, 1)
progr + 1
Case isParenth(Mid(expr, progr, 1))
ttype = #DELIM
token = Mid(expr, progr, 1)
progr + 1
Case isDelim(Mid(expr, progr, 1))
ttype = #DELIM
While isDelim(Mid(expr, progr, 1))
token + Mid(expr, progr, 1)
progr + 1
Wend
If notVailidop(token)
error = ERR_SYNTAX
EndIf
Case isAlpha(Mid(expr, progr, 1))
While notDelim(Mid(expr, progr, 1))
token + Mid(expr, progr, 1)
progr + 1
Wend
If isFunc(token)
ttype= #FUNCTION
Else
If isCommand(token)
ttype = #COMMAND
Else
ttype = #VARIABLE
EndIf
EndIf
Case isDigit(Mid(expr, progr, 1))
ttype = #NUMBER
While NotDelim(Mid(expr, progr, 1))
token + Mid(expr, progr, 1)
progr + 1
Wend
EndSelect
EndProcedure
Procedure isFunc(str.s)
For i = 0 To #MAXFNC - 1
If str = fnc(i)
ProcedureReturn #True
EndIf
Next
ProcedureReturn #False
EndProcedure
Procedure isCommand(str.s)
For i = 0 To #MAXCMD - 1
If str = cmd(i)
ProcedureReturn #True
EndIf
Next
ProcedureReturn #False
EndProcedure
Procedure isMinus(str.s)
If FindString("-", str, 1)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure isParenth(str.s)
If FindString("()", str, 1)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure isDelim(str.s)
If (FindString("&|<>+/*^=", str, 1) > 0) And (str <> "")
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure NotDelim(str.s)
If (FindString("&|<>+-/*^=()" + Chr(32) + Chr(9), str, 1) > 0) Or (str = "")
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure isAlpha(str.s)
If FindString("ABCDEFGHIJKLMNOPQRSTUVWXYZ", str, 1)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure isDigit(str.s)
If FindString(".0123456789", str, 1)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure isSpace(str.s)
If ((str = " ") Or (str = Chr(9))) And (str <> "")
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
Procedure notVailidop(op.s)
If Len(op) = 1
ProcedureReturn #False
EndIf
Select token
Case "<>"
ProcedureReturn #False
Case "<= "
ProcedureReturn #False
Case ">= "
ProcedureReturn #False
Case "== "
ProcedureReturn #False
Case "--"
ProcedureReturn #False
EndSelect
ProcedureReturn #True
EndProcedure
Procedure isErr(str.s)
;Check for some errors
str1.s
str2.s
err = 0
str = UCase(str)
;Check for unbalanced parentheses
For i = 1 To Len(str)
If Mid(str, i, 1) = "("
err + 1
EndIf
If Mid(str, i, 1) = ")"
err - 1
EndIf
Next
If err
error = ERR_PARENTH
ProcedureReturn #True
EndIf
;Check for Illegal characters
str1 = " ABCDEFGHIJKLMNOPQRSTUVWXYZ"
str2 = "0123456789.&|<>+-/%*^=()" + Chr(9)
For i = 1 To Len(str)
If FindString(str1 + str2, Mid(str, i, 1), 1) = 0
err + 1
EndIf
Next
If err
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
;DEMO
OpenConsole()
ConsoleTitle("Expression evaluator")
eval("a = 10")
eval("b = 25.25")
PrintN(StrF(eval("a * b+b")))
PrintN("[Enter] to end...")
Input()
end