Maybe something for the math library... a WIP Math Parser!

[keeling]

Jean Debord had posted some work on a math library for FB. I asked if he had thought about a math parser. The reply was that he wasn't "skilled enough" to do it (I've looked at your work and I doubt that statement).

Personally, I have been looking for a good math parser in BASIC for years (on and off). At one point someone had advised me to use RPN. As a long time user of HP calculators I was comfortable with Postfix notation but just couldn't get my head around how to do it in BASIC. Its been a few years and Jean's work and comment got me thinking and here are the results of that thinking. It is a WIP math parser.

Its undocumented, sloppy, not all of the functions are added yet (although it should be painfully obvious how to add new unary and binary operators) and not perfect.... i.e. its a WIP. But it does show how this can be done if someone else wants to jump in and help clean it up.

PLEASE PLEASE PLEASE test it. I have a bad habit of getting a piece of code to work with the few examples I've through out it and then forget to check other things.

Insert long winded code here.

Code:

Option Explicit

Const rpnFALSE As Integer = 0
Const rpnTRUE As Integer = Not rpnFALSE

Const MaxOperators As Integer = 100
Const MaxExpressions As Integer = 100
Const MaxVariables As Integer = 100

Const CurrentNumberOfOperators As Integer = 34

'Operator Constants
Const rpnNAO                As Integer = 0          'NOT AN OPERATOR
Const rpnLeftParenthesis    As Integer = 1
Const rpnRightParenthesis   As Integer = 2
Const rpnPlus               As Integer = 3
Const rpnMinus              As Integer = 4
Const rpnMultiply           As Integer = 5
Const rpnDivide             As Integer = 6
Const rpnPercent            As Integer = 7
Const rpnIntegerDivision    As Integer = 8
Const rpnPow                As Integer = 9
Const rpnAbs                As Integer = 10
Const rpnAtan               As Integer = 11
Const rpnCos                As Integer = 12
Const rpnSin                As Integer = 13
Const rpnExp                As Integer = 14
Const rpnFix                As Integer = 15
Const rpnInt                As Integer = 16
Const rpnLn                 As Integer = 17
Const rpnLog                As Integer = 18
Const rpnRnd                As Integer = 19
Const rpnSgn                As Integer = 20
Const rpnSqr                As Integer = 21
Const rpnTan                As Integer = 22
Const rpnAcos               As Integer = 23
Const rpnAsin               As Integer = 24
Const rpnCosh               As Integer = 25
Const rpnSinh               As Integer = 26
Const rpnTanh               As Integer = 27
Const rpnAcosh              As Integer = 28
Const rpnAsinh              As Integer = 29
Const rpnAtanh              As Integer = 30
Const rpnMod                As Integer = 31
Const rpnFact               As Integer = 32
Const rpnNeg                As Integer = 33
Const rpnLog10              As Integer = 34

declare Function EvalPostFix(PostFixString As String, NumOfVariables As Integer, Variables() As String) As Double
declare Function ConvertInfixToPostFix(TExpression As String) As String
declare Function PushOperator(ByVal Object As Integer, ByRef StackPointer As Integer, _
                        Stack() As Integer) As Integer
declare Function PopOperator(ByRef StackPointer As Integer, _
                        Stack() As Integer) As Integer
declare Function PushExpression(ByRef Object As String, _
                           ByRef StackPointer As Integer, _
                           Stack() As String) As Integer
declare Function PopExpression(ByRef StackPointer As Integer, _
                        Stack() As String) As String
declare Sub Update(ByVal Operator As Integer, ByRef Expression As String, _
                        ByRef OSP As Integer, ByRef ESP As Integer, _
                        OStack() As Integer, EStack() As String)
declare Function GetPriority(Operator As Integer) As Integer
declare Function NotOperator(Item As String) As Integer                        
declare Sub DefineVariables(NumOfVariables As Integer, VariableList() As String)
declare Function FindVariables(PostFix As String, VariableArray() As String) As Integer
declare Function GetOperatorString(Operator As Integer) As String
declare Function rpnIsNumeric(ValString as string) as integer


'-----------------------------------------------------------
'Driver Program
    
   Dim infix As String
   Dim PostFix As String
   Dim v(MaxVariables) As String
   Dim r As Integer
   dim i as integer
  
   input$ "Please enter a mathematical expression: ", infix
   ? "The Infix expression is: "; infix
   PostFix = ConvertInfixToPostFix(infix)
   ?
   ? "The postfix is: " + PostFix
  
   r = FindVariables(PostFix, v())
  
   if r<> 0 then
      ?
      ? "The variables in this expression are:"
      
      for i = 1 to r
         ? v(i)
      next i
      ?
      DefineVariables r, v()
   end if
   ?
   ? "The evaluated postfix expression is: ";
   ? EvalPostFix(PostFix, r, v())
   sleep
   end

'-------------------------------------------------------------
'functions
Function EvalPostFix(PostFixString As String, NumOfVariables As Integer, Variables() As String) As Double
'Valid PostFix String is <something><space><something><space>.......<something><space>
   Dim ExpressionStack(MaxExpressions) As String
   Dim ESP As Integer
   Dim Position As Integer
   Dim TokenString As String
   Dim WorkingString As String
  
   Dim Var1 As String
   Dim Var2 As String
  
    Dim A As Double
    Dim B As Double
    Dim PushString As String
    Dim i As Integer
    
    Dim EPosition As Integer
        
  
  
   WorkingString = PostFixString
   ESP = 0
  
   Position = InStr(WorkingString, " ")
  
   If Position = 0 Then
      Print "ERROR"
      End
   End If
  
   Do While (Position <> 0)
      TokenString = Left$(WorkingString, Position - 1)
      WorkingString = Mid$(WorkingString, Position + 1)
      Position = InStr(WorkingString, " ")
      Select Case TokenString
         Case GetOperatorString(rpnPlus)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B + A), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnMinus)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B - A), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnMultiply)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B * A), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnDivide)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B / A), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnIntegerDivision)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B \ A), ESP, ExpressionStack()
        
        
         Case GetOperatorString(rpnPow), GetOperatorString(rpnExp)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$(B ^ A), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnMod)
            Var1 = PopExpression(ESP, ExpressionStack())
            Var2 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            B = Val(Var2)
            PushExpression Str$((B Mod A)), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnSin)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Sin(A)), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnCos)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Cos(A)), ESP, ExpressionStack()
        
         Case GetOperatorString(rpnTan)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Tan(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnAtan)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Atn(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnAbs)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Abs(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnRnd)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Rnd(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnLog)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Log(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnLn)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Log(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnLog10)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            'log(10) = 2.30258509299
            PushExpression Str$(Log(A) / 2.30258509299), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnInt)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Int(A)), ESP, ExpressionStack()
        
        Case GetOperatorString(rpnFix)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Fix(A)), ESP, ExpressionStack()
                    
        Case GetOperatorString(rpnSgn)
            Var1 = PopExpression(ESP, ExpressionStack())
            A = Val(Var1)
            PushExpression Str$(Sgn(A)), ESP, ExpressionStack()
                    
        
        Case Else
         'must be an opperand
         'when variable and constant support is added,
         'it could be added here
         'pass the function and array of variables as strings
         'i.e Variables(1) might be "x=4.5"
         '    Variables(2) might be "SigmaZ = 23.55234"
         'the code would then go through each each index looking for the
         'variable or constant then replace it on the stack
         'for now, we'll just push
            PushString = TokenString
            If ((NumOfVariables <> 0) And (rpnIsNumeric(TokenString) = rpnFalse)) Then
                For i = 1 To NumOfVariables
                    EPosition = InStr(Variables(i), "=")
                    If EPosition <> 0 Then
                        If PushString = LCase$(Left$(Variables(i), EPosition - 1)) Then
                            PushString = Mid$(Variables(i), EPosition + 1)
                            Exit For
                        End If
                    End If
                Next i
            End If
                    
            Select Case TokenString
                Case "pi"
                    PushString = "3.1415926535897932384626433832795028841971693993751"
            End Select
            
            PushExpression PushString, ESP, ExpressionStack()
      End Select
   Loop
   EvalPostFix = Val(ExpressionStack(1))
End Function

Function ConvertInfixToPostFix(TExpression As String) As String
  
   Dim OperatorStack(MaxOperators) As Integer
   Dim ExpressionStack(MaxExpressions) As String
  
   Dim OSP As Integer
   Dim ESP As Integer
  
   Dim TokenString As String
   Dim Token As Integer
  
   Dim Position As Integer
   Dim Offset As Integer
   Dim Length As Integer
  
   Dim Expression As String
   Dim VariableBuffer As String
  
   Dim Operator As Integer
  
   Dim ErrorCode As Integer
  
   Dim CheckLeft As String
  
   Dim Counter As Integer
  
   Dim ReturnAnswer As String
   Dim TempExpression As String
   ErrorCode = rpnFALSE
  
   OSP = 0
   ESP = 0
  
  
   VariableBuffer = ""
  
   Expression = LCase$(TExpression)
   Length = Len(Expression)
  
   Offset = 1
   Position = 1
  
   TokenString = Left$(Expression, Offset)
  
   'Main loop
   Do While (Not ErrorCode) And (Position <= Length)
      Operator = rpnFALSE
      Offset = 1
         Select Case TokenString
         Case "+"
            Operator = rpnTRUE
            Token = rpnPlus
         Case "-"
            Operator = rpnTRUE
            Token = rpnMinus
         Case "*"
            Operator = rpnTRUE
            Token = rpnMultiply
         Case "/"
            Operator = rpnTRUE
            Token = rpnDivide
         Case "\"
            Operator = rpnTRUE
            Token = rpnIntegerDivision
         Case "^"
            Operator = rpnTRUE
            Token = rpnPow
         Case "("
            Operator = rpnTRUE
            Token = rpnLeftParenthesis
         Case ")"
            Operator = rpnTRUE
            Token = rpnRightParenthesis
         Case "a"
            If Mid$(TExpression, Position, 3) = "atn" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnAtan
            End If
            If Mid$(TExpression, Position, 4) = "atan" Then
               Operator = rpnTRUE
               Offset = 4
               Token = rpnAtan
            End If
            If Mid$(TExpression, Position, 3) = "abs" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnSin
            End If
         Case "b"
         Case "c"
            If Mid$(TExpression, Position, 3) = "cos" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnCos
            End If
         Case "e"
            If Mid$(TExpression, Position, 3) = "exp" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnExp
            End If
         Case "f"
            If Mid$(TExpression, Position, 3) = "fix" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnFix
            End If
         Case "h"
         Case "i"
            If Mid$(TExpression, Position, 3) = "int" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnInt
            End If
         Case "j"
         Case "k"
         Case "l"
            If Mid$(TExpression, Position, 3) = "log" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnLog
            End If
            If Mid$(TExpression, Position, 2) = "ln" Then
               Operator = rpnTRUE
               Offset = 2
               Token = rpnLn
            End If
            If Mid$(TExpression, Position, 5) = "log10" Then
               Operator = rpnTRUE
               Offset = 5
               Token = rpnLog10
            End If
         Case "m"
            If Mid$(TExpression, Position, 3) = "mod" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnMod
            End If
         Case "n"
         Case "o"
         Case "p"
            If Mid$(TExpression, Position, 3) = "pow" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnPow
            End If
         Case "q"
         Case "r"
            If Mid$(TExpression, Position, 3) = "rnd" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnRnd
            End If
         Case "s"
            If Mid$(TExpression, Position, 3) = "sin" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnSin
            End If
            If Mid$(TExpression, Position, 3) = "sgn" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnSgn
            End If
         Case "t"
            If Mid$(TExpression, Position, 3) = "tan" Then
               Operator = rpnTRUE
               Offset = 3
               Token = rpnTan
            End If
         Case "u"
         Case "v"
         Case "w"
         Case "x"
         Case "y"
         Case "z"
         Case Else
      End Select
      If Operator Then
         'check + and - to see if they are unary or binary
         Select Case Token
            Case rpnPlus, rpnMinus
               Select Case Position
                  Case 1
                     'if its the first character, then it has to be unary
                     'in that cass just make it part of the variable
                     VariableBuffer = VariableBuffer + TokenString
                  Case 2
                     If Left$(Expression, 1) = "(" Then
                        'its unary
                        VariableBuffer = VariableBuffer + TokenString
                     Else
                        Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
                     End If
                  Case Is > 2
                     'This could be either one
                     CheckLeft = Mid$(Expression, Position - 2, 2)
                     If NotOperator(CheckLeft) Then
                        VariableBuffer = VariableBuffer + TokenString
                     Else
                        Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
                     End If
               End Select
            Case Else
               Update Token, VariableBuffer, OSP, ESP, OperatorStack(), ExpressionStack()
         End Select
      Else
         If TokenString <> " " Then VariableBuffer = VariableBuffer + TokenString
      End If
      
      Position = Position + Offset
      TokenString = Mid$(Expression, Position, 1)
   Loop

   PushExpression VariableBuffer, ESP, ExpressionStack()
  
  
   Dim ReturnOperator As Integer
   Dim ReturnString As String
  
   Do While OSP <> 0
      ReturnOperator = PopOperator(OSP, OperatorStack())
      ReturnString = GetOperatorString(ReturnOperator)
      PushExpression ReturnString, ESP, ExpressionStack()
   Loop
  
   ReturnAnswer = ""
   For Counter = 1 To ESP
      TempExpression = Trim$(ExpressionStack(Counter))
      If TempExpression <> "" Then ReturnAnswer = ReturnAnswer + TempExpression + " "
   Next Counter
  
   ConvertInfixToPostFix = ReturnAnswer
End Function
Function PushOperator(ByVal Object As Integer, ByRef StackPointer As Integer, _
                        Stack() As Integer) As Integer
    StackPointer = StackPointer + 1
  
    If StackPointer > MaxOperators Then
        PushOperator = rpnFALSE
    Else
        Stack(StackPointer) = Object
        PushOperator = rpnTRUE
    End If
End Function
Function PopOperator(ByRef StackPointer As Integer, _
                        Stack() As Integer) As Integer
    If StackPointer = 0 Then
        PopOperator = rpnFALSE
    Else
        PopOperator = Stack(StackPointer)
        StackPointer = StackPointer - 1
    End If
End Function

Function PushExpression(ByRef Object As String, _
                           ByRef StackPointer As Integer, _
                           Stack() As String) As Integer

   StackPointer = StackPointer + 1
  
   If StackPointer > MaxExpressions Then
     PushExpression = rpnFALSE
   Else
     Stack(StackPointer) = Object
     PushExpression = rpnTRUE
   End If

End Function

Function PopExpression(ByRef StackPointer As Integer, _
                        Stack() As String) As String

   If StackPointer = 0 Then
      PopExpression = "rpnfalse"
   Else
     PopExpression = Stack(StackPointer)
     StackPointer = StackPointer - 1
   End If

End Function


Sub Update(ByVal Operator As Integer, ByRef Expression As String, _
                        ByRef OSP As Integer, ByRef ESP As Integer, _
                        OStack() As Integer, EStack() As String)
  
   Dim ReturnPriority As Integer
   Dim ReturnAnswer As Integer
   Dim ReturnOperator As Integer
   Dim ReturnString As String
   If Trim$(Expression) <> "" Then ReturnAnswer = PushExpression(Expression, ESP, EStack())
   Expression = ""
  
   Select Case Operator
      Case rpnLeftParenthesis
         ReturnAnswer = PushOperator(Operator, OSP, OStack())
      Case rpnRightParenthesis
         ReturnOperator = PopOperator(OSP, OStack())
         Do While ReturnOperator <> rpnLeftParenthesis
            ReturnString = GetOperatorString(ReturnOperator)
            PushExpression ReturnString, ESP, EStack()
            ReturnOperator = PopOperator(OSP, OStack())
         Loop
        
        ReturnOperator = PopOperator(OSP, OStack())
        ReturnString = GetOperatorString(ReturnOperator)
        PushExpression ReturnString, ESP, EStack()
      Case Else
         If OSP = 0 Then
            PushOperator Operator, OSP, OStack()
         Else
            ReturnPriority = GetPriority(Operator)
            If (ReturnPriority > GetPriority(OStack(OSP))) Then
               PushOperator Operator, OSP, OStack()
            Else
               Do While (ReturnPriority <= GetPriority(OStack(OSP)) And (OSP <> 0))
                  ReturnOperator = PopOperator(OSP, OStack())
                  ReturnString = GetOperatorString(ReturnOperator)
                  PushExpression ReturnString, ESP, EStack()
               Loop
               PushOperator Operator, OSP, OStack()
            End If
         End If
   End Select


  
End Sub
Function GetPriority(Operator As Integer) As Integer
  Select Case Operator
    Case rpnLeftParenthesis
      GetPriority = 10
    Case rpnPlus, rpnMinus
      GetPriority = 30
    Case rpnMultiply, rpnDivide, rpnIntegerDivision
      GetPriority = 40
    Case rpnPow
      GetPriority = 50
   Case Else
      'functions
      GetPriority = 60
  End Select
End Function
Function NotOperator(Item As String) As Integer
   NotOperator = rpnFALSE
   Select Case Right$(Item, 1)
   Case "+", "-", "*", "/", "\", "(", "^"
      NotOperator = rpnTRUE
   Case "e"
      Select Case Left$(Item, 1)
         Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "."
            NotOperator = rpnTRUE
      End Select
   End Select
End Function
Function GetOperatorString(Operator As Integer) As String
    Select Case Operator
    Case rpnLeftParenthesis
        GetOperatorString = "("
    Case rpnRightParenthesis
        GetOperatorString = ")"
    Case rpnPlus
        GetOperatorString = "+"
    Case rpnMinus
        GetOperatorString = "-"
    Case rpnMultiply
        GetOperatorString = "*"
    Case rpnDivide
        GetOperatorString = "/"
    Case rpnPercent
        GetOperatorString = "%"
    Case rpnIntegerDivision
        GetOperatorString = "\"
    Case rpnPow, rpnExp
        GetOperatorString = "^"
    Case rpnAbs
        GetOperatorString = "ABS"
    Case rpnAtan
        GetOperatorString = "ATAN"
    Case rpnCos
        GetOperatorString = "COS"
    Case rpnSin
        GetOperatorString = "SIN"
    Case rpnExp
        GetOperatorString = "^"
    Case rpnFix
        GetOperatorString = "FIX"
    Case rpnInt
        GetOperatorString = "INT"
    Case rpnLn
        GetOperatorString = "LN"
    Case rpnLog
        GetOperatorString = "LOG"
    Case rpnRnd
        GetOperatorString = "RND"
    Case rpnSgn
        GetOperatorString = "SGN"
    Case rpnSqr
        GetOperatorString = "SQR"
    Case rpnTan
        GetOperatorString = "TAN"
    Case rpnAcos
        GetOperatorString = "ACOS"
    Case rpnAsin
        GetOperatorString = "ASIN"
    Case rpnCosh
        GetOperatorString = "COSH"
    Case rpnSinh
        GetOperatorString = "SINH"
    Case rpnTanh
        GetOperatorString = "TANH"
    Case rpnAcosh
        GetOperatorString = "ACOSH"
    Case rpnAsinh
        GetOperatorString = "ASINH"
    Case rpnAtanh
        GetOperatorString = "ATANH"
    Case rpnMod
        GetOperatorString = "MOD"
    Case rpnFact
        GetOperatorString = "FACT"
    Case rpnNeg
        GetOperatorString = "NEG"
    Case rpnLog10
        GetOperatorString = "LOG10"
    Case Else
        GetOperatorString = "ERROR"
    End Select
End Function
Function FindVariables(PostFix As String, VariableArray() As String) As Integer
    Dim Position As Integer
    Dim TokenString As String
    Dim WorkingString As String
    Dim IsOp As Integer
    Dim i As Integer
    dim ReturnAnswer as integer
    dim NewVariable as integer
    
    WorkingString = PostFix
    Position = InStr(WorkingString, " ")
    ReturnAnswer = 0
    
    Do While (Position <> 0)
        TokenString = Left$(WorkingString, Position - 1)
        WorkingString = Mid$(WorkingString, Position + 1)
        Position = InStr(WorkingString, " ")
        If rpnIsNumeric(TokenString) = rpnFalse Then
            IsOp = rpnFALSE
            For i = 1 To CurrentNumberOfOperators
                If TokenString = GetOperatorString(i) Then
                    IsOp = rpnTRUE
                    Exit For
                End If
            Next i
            If IsOp = rpnFALSE Then
                Select Case LCase$(TokenString)
                    Case "pi"
                        'do nothing, just check if its a constant that is defined
                    Case Else
                       NewVariable = rpnTrue
                        for i = 1 to returnanswer
                           if tokenstring + "=" = VariableArray(i) then
                              NewVariable = rpnFalse
                              exit for
                           end if
                        next i
                        if NewVariable = rpnTrue then
                           'it has to be a new variable
                           ReturnAnswer = ReturnAnswer + 1
                           VariableArray(ReturnAnswer) = TokenString + "="
                        end if
                End Select
            End If
        End If
    Loop
    FindVariables = ReturnAnswer
End Function
Sub DefineVariables(NumOfVariables As Integer, VariableList() As String)
    Dim i As Integer
    Dim ReturnAnswer As String
    For i = 1 To NumOfVariables
         ? VariableList(i);
         input$ ReturnAnswer
        VariableList(i) = VariableList(i) + Trim$(ReturnAnswer)
    Next i
    
End Sub
function rpnIsNumeric(ValString as string) as integer
   Dim DecimalCount as integer
   dim MinusCount as integer
   dim PlusCount as integer
   Dim ECount as integer
  
   Dim IsNumericCounter as integer
   Dim Length As Integer
   dim CheckCharacter as String
  
  
   DecimalCount=0
   MinusCount=0
   PlusCount=0
   ECount=0
  
   Length = len(ValString)
  
   For IsNumericCounter = 1 to Length
      
      CheckCharacter = mid$(ValString,IsNumericCounter,1)
      
      select case CheckCharacter
         case "0","1","2","3","4","5","6","7","8","9"
         'we are fine with these, go on to something else
         case "."
            DecimalCount = DecimalCount + 1
            'There can be only one!
            if DecimalCount>1 then
               rpnIsNumeric=rpnFALSE
               exit function
            end if
            if ECount<>0 then
               rpnIsNumeric=rpnFALSE
               exit function
            end if              
         case "+"
            PlusCount = PlusCount + 1
            if (((IsNumericCounter<>1) and (ECount=0)) or (PlusCount>2)) then
               rpnIsNumeric=rpnFALSE
               exit function
            end if
            if (IsNumericCounter<>1) then
                  if lcase$(mid$(ValString,IsNumericCounter-1,1))<>"e" then
                     rpnIsNumeric=rpnFALSE
                     exit function
                  end if
            end if                                
         case "-"
            MinusCount = MinusCount + 1
            if (((IsNumericCounter<>1) and (ECount=0)) or (MinusCount>2)) then
               rpnIsNumeric=rpnFALSE
               exit function
            end if
            if (IsNumericCounter<>1) then
                  if lcase$(mid$(ValString,IsNumericCounter-1,1))<>"e" then
                     rpnIsNumeric=rpnFALSE
                     exit function
                  end if
            end if                    
         case "e","E"
            ECount=ECount+1
            if (IsNumericCounter=1) or (ECount>1) then
               rpnIsNumeric=rpnFALSE
               exit function
            end if
            if (mid$(ValString,IsNumericCounter-1,1))="+" or _
             (mid$(ValString,IsNumericCounter-1,1))="-" then
               rpnIsNumeric=rpnFALSE
               exit function
            end if
            
         case Else
            rpnIsNumeric=rpnFALSE
            exit function
      end select
   next IsNumericCounter
  
   rpnIsNumeric = rpnTRUE
END FUNCTION

[jdebord]

Thank you very much. I am checking it with FB 0.12b. I will post more comments later.

[gbos]

There are working parsers developed in bcx and rapidq. For example this is the core for a bcx parser. I think they can be translated into FB relatively easy.

Code:

' Evaluating a simple string 2+3*5+2^2 and returns a string with the answer
' else it returns "Division by zero!"

Function EvaluateTheString2$(pass$)
Dim a#[100]
Dim ap%[100]
Dim TheString$
TheString$=pass$
if LEN(TheString$)=0 then
    FUNCTION="0"
End if
TheString$=LCase$(TheString$)
TheString$="+"&TheString$
TheString$= REPLACE$(TheString$," ","")
TheString$= REPLACE$(TheString$,"++","+")
TheString$= REPLACE$(TheString$,"-+","-")
TheString$= REPLACE$(TheString$,"--","+")
' add these to follow excel notation
TheString$= REPLACE$(TheString$,"/-","/+-")
TheString$= REPLACE$(TheString$,"*-","*+-")
TheString$= REPLACE$(TheString$,"^-","^+-")
'TheString$= REPLACE$(TheString$,"+-","-")
Dim i%,x%,dx%,ct%,j%,maxi%
Dim e$
Dim s#
i%=0
maxi%=0
x%=0
s#=0
do
x%=x%+1
e$=mid$(TheString$,x%,1)
if LEN(e$)=0 then exit do
if e$="0" or e$="1" or e$="2" or e$="3" or e$="4" or e$="5" or e$="6" or e$="7" or e$="8" or e$="9" or e$="." then
    dx%=0
    do
    dx%=dx%+1
    e$=mid$(TheString,x%+dx%,1)
    if ((e$="+" or e$="-") and (mid$(TheString$,x%+dx%-1,1)<>"e")) or e$="^" or e$="*" or e$="/" or LEN(e$)=0 then
        i%=i%+1
        a#[i%]=val(mid$(TheString$,x%,dx%))
            exit do
    end if
    loop
            x%=x%+dx%
end if
if e$="+" then
    dx%=0
    do
    dx%=dx%+1
    e$=mid$(TheString$,x%+dx%,1)
    if ((e$="+" or (e$="-" and dx%<>1)) and mid$(TheString$,x%+dx%-1,1)<>"e") or e$="^" or e$="*" or e$="/" or LEN(e$)=0 then
        i%=i%+1
        a#[i%]=val(mid$(TheString,x%+1,dx%-1))
            exit do
    end if
    loop
            x%=x%+dx%-1
end if
'if i%=0 and e$="-" then
'a#[1]=0
'i%=1
'end if
if e$="^" then ap%[i%]=3
if e$="*" then ap%[i%]=2
if e$="/" then ap%[i%]=1
if e$="-" then 'ap(i)=ap(i)+4
if ap%[i%]=3 then ap%[i%]=7
if ap%[i%]=2 then ap%[i%]=6
if ap%[i%]=1 then ap%[i%]=5
if ap%[i%]=4 then ap%[i%]=0
if ap%[i%]=0 then ap%[i%]=4
end if
loop
maxi%=i%
'calculate "^"
ct%=0
do
ct%=ct%+1
if ct%=i% then exit do
if ap%[ct%]=3 then
    a#[ct%]=a#[ct%]^a#[ct%+1]
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
if ap%[ct%]=7 then
    a#[ct%]=a#[ct%]^(-a#[ct%+1])
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
loop
'calculate "*" & "/"
ct%=0
do
ct%=ct%+1
if ct%=i then exit do
if ap%[ct%]=2 then
    a#[ct%]=a#[ct%]*a#[ct%+1]
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
if ap%[ct%]=6 then
    a#[ct%]=a#[ct%]*(-a#[ct%+1])
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
if ap%[ct%]=1 then
if a#[ct%+1]=0 then
    'Division by zero!
    'TheError=1
    function="Division by zero!"
End if
    a#[ct%]=a#[ct%]/a#[ct%+1]
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
if ap%[ct%]=5 then
if a#[ct%+1]=0 then
    'Division by zero!
    'TheError=1
    function="Division by zero!"
End if
    a#[ct%]=a#[ct%]/(-a#[ct%+1])
    for j%=ct%+1 to i%-1
    a#[j%]=a#[j%+1]
    ap%[j%-1]=ap%[j%]
    next j%
    i%=i%-1
ct%=0
end if
loop
for ct%=2 to i%
if ap%[ct%-1]=0 then
s#=s#+a#[ct%]
else
s#=s#-a#[ct%]
end if
next ct%
s#=s#+a#[1]
FUNCTION=str$(s#)
End Function

[marzecTM]

does this parser only evaluate numeric expressions? or should it also be able to handle derivation of functions etc.?

[keeling]

A derivation would be done with routines.... which are easy to do for numerical derivations.

A parser just gives the program access to a user input function.

If you are looking for numerical integration and derivation I can work up some in very short order.

[keeling]

I have seen code like this but it (the BCX you posted) works, and would be easy to translate, but it doesn't handle functions, variables, or mathematical constants.... mine does (or will)... I haven't crashed it in moderate use yet, but if someone does find something in mine please let me know.

Mine is just another version... use what you like.

[marzecTM]

uhm, i didn't read your first post properly and hacked a parser for math expressions myself. well it's not stack/postfix based but a recursive decent parser. maybe you can use it, i guess it's easier to extend it, here's the code ( sorry was to lazy to upload it )

Code:

'------------------------------------------------------------------------------
' Math Expression Parser
'
' file: mathparse.bas
'
' desc: this thingy takes a string that contains a math expression and
'       returns the result the expression as a string. errors are indicated
'       with a returnvalue of 0 and the string gets filled with the error
'       description.
'
'       the parser follows this ebnf grammar
'
'       addexpr         := mulexpr ( ( + | - ) mulexpr )*
'
'
'       mulexp          := negexp ( ( '*' | '/' ) negexp )*
'
'
'       negexp          := ('-' | '+') expexpr
'                        | expexpr
'
'
'       expexpr         := atom ( ^ atom )*
'
'       funcexpr        := 'cos' '(' addexpr ')'
'                        | 'sin' '(' addexpr ')'
'                        | paraexpr
'
'       paraexp         := '(' addexpr ')'
'                        | atom
'
'       atom            := NUMBER
'
'  
'       the module is really composed of 2 modules, one that lexes the string
'       and the other parses and returns the result. if you want more functions
'       then simply extend parFuncExpr and follow the sin/cos examples there.
'       you'll also have to extend the lex function so that it recognizes
'       your keyword for your function ( see the last code block there, take
'       cos sin as an example again). Note that function names can only be composed
'       of the letters a - z
'
'
'       currently supported operators and function:
'       -------------------------------------------
'
'       + -                addition, substraction
'       * /                multiplication, division
'       - +                unary sign
'       ^                  power ( also fractions allowed )
'       cos( expr )        cosinus of the expression in radians
'       sin( expr )        sinus of the expression in radians
'       ( )                paranthesis to group expressions
'
'       all numbers are handled as double, fractions are seperated with a dot '.'
'       if you have several dots within a number then the fraction after the
'       second dot is ignored.
'
'       to use this in your own programms just declare mathParser and mathParserGetErrorMsg
'       like this
'
'       declare function mathParser( mathexpr as string, result as string) as integer
'       declare function mathParserGetErrorMsg( ) as string
'      
'       simply pass your math expression string to mathParser, it will return 0 on failure
'       and -1 on success, and stores the result in the passed result string. if there
'       was an error you can call mathParserGetErrorMsg to get a descriptive error message
'
'
'------------------------------------------------------------------------------
option explicit

declare function parAddExpr( ) as double
declare function parMulExpr( ) as double
declare function parNegExpr( ) as double
declare function parExpExpr( ) as double
declare function parFuncExpr( ) as double
declare function parParaExpr( ) as double
declare function parAtom( ) as double

enum TokenType
   TOKEN.TYPE.ADD
   TOKEN.TYPE.SUB
   TOKEN.TYPE.DIV
   TOKEN.TYPE.MUL
   TOKEN.TYPE.LPARA
   TOKEN.TYPE.RPARA
   TOKEN.TYPE.POW
   TOKEN.TYPE.NUMBER
   TOKEN.TYPE.COS
   TOKEN.TYPE.SIN
   TOKEN.TYPE.EOS
   TOKEN.TYPE.UNKNOWN
end enum

type token
   type_ as TokenType
   value as double
end type

type LexerCtx
   curr_char as byte ptr
   token as Token  
end type


dim shared lexer as LexerCtx
dim shared tmp_str as string        ' this here is a bad bad hack, no dyn strings in udts
                                    ' so we have to store that here...


function LexerInit ( mathexpr as string ) as integer

   tmp_str = mathexpr
   lexer.curr_char = sadd(tmp_str)  

end function


sub lex( )

   dim tmp_number as string

   lexer.token.type_ = TOKEN.TYPE.UNKNOWN
   lexer.token.value = 0.0


   '' check for whitespaces and loop over them
   while( *lexer.curr_char = asc(" ") or *lexer.curr_char = 9 )
      lexer.curr_char += 1
   wend


   '' EOS
   if( *lexer.curr_char = 0 ) then
      lexer.token.type_ = TOKEN.TYPE.EOS
      lexer.token.value = 0.0
      exit sub
   end if

   '' found a number let's lex it
   if( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) then
      tmp_number = chr$(*lexer.curr_char)
      lexer.curr_char += 1
    
      while( ( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) or *lexer.curr_char= ASC(".") )
         tmp_number += chr$(*lexer.curr_char)
         lexer.curr_char += 1
      wend
  
      lexer.token.type_ = TOKEN.TYPE.NUMBER
      lexer.token.value = val(tmp_number)
      exit sub
   end if  
  
   '' otherwise it must be one of the operators ( '(', ')', '*', '/', '+', '-', '^' )
   select case *lexer.curr_char
      case asc("("):
         lexer.token.type_ = TOKEN.TYPE.LPARA
      case asc(")"):
         lexer.token.type_ = TOKEN.TYPE.RPARA
      case asc("*"):
         lexer.token.type_ = TOKEN.TYPE.MUL
      case asc("/"):
         lexer.token.type_ = TOKEN.TYPE.DIV
      case asc("+"):
         lexer.token.type_ = TOKEN.TYPE.ADD
      case asc("-"):
         lexer.token.type_ = TOKEN.TYPE.SUB
      case asc("^"):
         lexer.token.type_ = TOKEN.TYPE.POW
   end select

   if( lexer.token.type_ <> TOKEN.TYPE.UNKNOWN ) then
      lexer.curr_char += 1
      exit sub
   end if

   '' otherwise we check wheter we got a keyword
   dim keyword as string
   while( (*lexer.curr_char <> asc(" ") and *lexer.curr_char <> 9 and *lexer.curr_char <> 0) and _
          (lcase$(*lexer.curr_char) >= "a" and lcase$(*lexer.curr_char) <= "z" ) )
      keyword += chr$(*lexer.curr_char)
      lexer.curr_char += 1
   wend

   select case UCASE$(keyword)
      case "SIN":
         lexer.token.type_ = TOKEN.TYPE.SIN
      case "COS":
         lexer.token.type_ = TOKEN.TYPE.COS
   end select

end sub


sub lexerTest()
   dim mathexpr as string

   line input "mathexpression:", mathexpr
   LexerInit mathexpr
   leX()

   while( lexer.token.type_ <> TOKEN.TYPE.EOS and lexer.token.type_ <> TOKEN.TYPE.UNKNOWN )
     select case lexer.token.type_
        case TOKEN.TYPE.ADD:
           print "TOKEN.TYPE.ADD ";
        case TOKEN.TYPE.SUB:
           print "TOKEN.TYPE.SUB ";
        case TOKEN.TYPE.MUL:
           print "TOKEN.TYPE.MUL ";
        case TOKEN.TYPE.DIV:
           print "TOKEN.TYPE.DIV ";
        case TOKEN.TYPE.POW:
           print "TOKEN.TYPE.POW ";
        case TOKEN.TYPE.LPARA:
           print "TOKEN.TYPE.LPARA ";
        case TOKEN.TYPE.RPARA:
           print "TOKEN.TYPE.RPARA ";
        case TOKEN.TYPE.NUMBER:
           print str$( lexer.token.value ) + " ";
     end select
     lex()
   wend

   if( lexer.token.type_ = TOKEN.TYPE.EOS ) then
      print " TOKEN.TYPE.EOS "
   else
      print " TOKEN.TYPE.UNKNOWN "
   end if
end sub


dim shared Parser.error as integer
dim shared Parser.errormsg as string


function mathParsergetErrorMsg() as string
   mathParserGetErrorMsg = Parser.errormsg
end function

function mathParser ( mathexpr as string, result as string) as integer
  
   dim res as double

   LexerInit mathexpr
   Parser.error = 0
   Parser.errormsg = ""
  
   lex()
   res = parAddExpr()
   result = str$(res)

   if( Parser.error ) then
      mathParser = 0
      exit function
   else
      mathParser = -1
      exit function
   end if

end function

function parAddExpr ( ) as double
  
   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parMulExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( +, - )?
   if( lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB )
         optype = lexer.token.type_
         lex()

         value2 = parMulExpr()
         if( Parser.error ) then exit function

         if( optype = TOKEN.TYPE.ADD ) then
            value1 += value2
         elseif( optype = TOKEN.TYPE.SUB ) then
            value1 -= value2
         end if
      wend
   end if

   parAddExpr = value1
  
end function

function parMulExpr ( ) as double

   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parNegExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( *, / )?
   if( lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV )
         optype = lexer.token.type_
         lex()

         value2 = parNegExpr()
         if( Parser.error ) then exit function

         if( optype = TOKEN.TYPE.MUL ) then
            value1 *= value2
         elseif( optype = TOKEN.TYPE.DIV ) then
            if( value2 = 0.0 ) then
               Parser.error = -1
               Parser.errormsg = "error: division by zero"
               exit function
            else
               value1 /= value2
            end if
         end if
      wend
   end if

   parMulExpr = value1
end function

function parNegExpr ( ) as double
   if( lexer.token.type_ = TOKEN.TYPE.SUB ) THEN
      lex()
      parNegExpr = parExpExpr()
   elseif ( lexer.token.type_ = TOKEN.TYPE.ADD ) then
      lex()
      parNegExpr = parExpExpr()
   else
      parNegExpr = parExpExpr()
   end if
end function

function parExpExpr ( ) as double
   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parFuncExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( *, / )?
   if( lexer.token.type_ = TOKEN.TYPE.POW ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.POW )
         optype = lexer.token.type_
         lex()

         value2 = parFuncExpr()
         if( Parser.error ) then exit function
        
         value1 = value1 ^ value2
      wend
   end if

   parExpExpr = value1  
end function

function parFuncExpr ( ) as double

   select case lexer.token.type_
      case TOKEN.TYPE.SIN:
         lex()  
         parFuncExpr = sin( parParaExpr )
      case TOKEN.TYPE.COS:
         lex()
         parFuncExpr = cos( parParaExpr )
      case else
         parFuncExpr = parParaExpr()
   end select


end function

function parParaExpr ( ) as double

   if( lexer.token.type_ = TOKEN.TYPE.LPARA ) then
      lex()

      parParaExpr = parAddExpr()
      if( Parser.error = -1 ) then exit function

      if( lexer.token.type_ <> TOKEN.TYPE.RPARA ) then
         Parser.error = -1
         Parser.errormsg = "error: expected ')'"
         print "paraexpr: " + str$(lexer.token.type_)
         exit function
      end if
      lex()
   else
      parParaExpr = parAtom()
   end if


end function

function parAtom ( ) as double
   if( lexer.token.type_ <> TOKEN.TYPE.NUMBER ) then
      Parser.error = -1
      Parser.errormsg = "error: expected number"
   else
      parAtom = lexer.token.value
      lex()
   end if

end function


dim mathexpr as string
dim result as string

line input "enter math expression:" , mathexpr
if( mathParser( mathexpr, result ) = 0 ) then
   print mathParserGetErrorMsg()
else
   print "result is:" + result
end if

[gbos]

marzecTM a small bug

-(-1^2) should return -1 and not 1.

[marzecTM]

hm, that is the result of the priorities used. power has bigger priority as the unary -. fb has the same behaviour, that is the same priorities. i could change that to the reverse order. for now if you want the power of a negativ number you have to enclose this number in paranthesis. e.g.:

-((-1)^2)

i found another bug though so here's the last version of it

Code:

'------------------------------------------------------------------------------
' Math Expression Parser
'
' file: mathparse.bas
'
' desc: this thingy takes a string that contains a math expression and
'       returns the result the expression as a string. errors are indicated
'       with a returnvalue of 0 and the string gets filled with the error
'       description.
'
'       the parser follows this ebnf grammar
'
'       addexpr         := mulexpr ( ( + | - ) mulexpr )*
'
'
'       mulexp          := negexp ( ( '*' | '/' ) negexp )*
'
'
'       negexp          := ('-' | '+') expexpr
'                        | expexpr
'
'
'       expexpr         := atom ( ^ atom )*
'
'       funcexpr        := 'cos' '(' addexpr ')'
'                        | 'sin' '(' addexpr ')'
'                        | paraexpr
'
'       paraexp         := '(' addexpr ')'
'                        | atom
'
'       atom            := NUMBER
'
'  
'       the module is really composed of 2 modules, one that lexes the string
'       and the other parses and returns the result. if you want more functions
'       then simply extend parFuncExpr and follow the sin/cos examples there.
'       you'll also have to extend the lex function so that it recognizes
'       your keyword for your function ( see the last code block there, take
'       cos sin as an example again). Note that function names can only be composed
'       of the letters a - z
'
'
'       currently supported operators and function:
'       -------------------------------------------
'
'       + -                addition, substraction
'       * /                multiplication, division
'       - +                unary sign
'       ^                  power ( also fractions allowed )
'       cos( expr )        cosinus of the expression in radians
'       sin( expr )        sinus of the expression in radians
'       ( )                paranthesis to group expressions
'
'       all numbers are handled as double, fractions are seperated with a dot '.'
'       if you have several dots within a number then the fraction after the
'       second dot is ignored.
'
'       to use this in your own programms just declare mathParser and mathParserGetErrorMsg
'       like this
'
'       declare function mathParser( mathexpr as string, result as string) as integer
'       declare function mathParserGetErrorMsg( ) as string
'      
'       simply pass your math expression string to mathParser, it will return 0 on failure
'       and -1 on success, and stores the result in the passed result string. if there
'       was an error you can call mathParserGetErrorMsg to get a descriptive error message
'
'
'------------------------------------------------------------------------------
option explicit

declare function parAddExpr( ) as double
declare function parMulExpr( ) as double
declare function parNegExpr( ) as double
declare function parExpExpr( ) as double
declare function parFuncExpr( ) as double
declare function parParaExpr( ) as double
declare function parAtom( ) as double

enum TokenType
   TOKEN.TYPE.ADD
   TOKEN.TYPE.SUB
   TOKEN.TYPE.DIV
   TOKEN.TYPE.MUL
   TOKEN.TYPE.LPARA
   TOKEN.TYPE.RPARA
   TOKEN.TYPE.POW
   TOKEN.TYPE.NUMBER
   TOKEN.TYPE.COS
   TOKEN.TYPE.SIN
   TOKEN.TYPE.EOS
   TOKEN.TYPE.UNKNOWN
end enum

type token
   type_ as TokenType
   value as double
end type

type LexerCtx
   curr_char as byte ptr
   token as Token  
end type


dim shared lexer as LexerCtx
dim shared tmp_str as string        ' this here is a bad bad hack, no dyn strings in udts
                                    ' so we have to store that here...


function LexerInit ( mathexpr as string ) as integer

   tmp_str = mathexpr
   lexer.curr_char = sadd(tmp_str)  

end function


sub lex( )

   dim tmp_number as string

   lexer.token.type_ = TOKEN.TYPE.UNKNOWN
   lexer.token.value = 0.0


   '' check for whitespaces and loop over them
   while( *lexer.curr_char = asc(" ") or *lexer.curr_char = 9 )
      lexer.curr_char += 1
   wend


   '' EOS
   if( *lexer.curr_char = 0 ) then
      lexer.token.type_ = TOKEN.TYPE.EOS
      lexer.token.value = 0.0
      exit sub
   end if

   '' found a number let's lex it
   if( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) then
      tmp_number = chr$(*lexer.curr_char)
      lexer.curr_char += 1
    
      while( ( *lexer.curr_char >= ASC("0") and *lexer.curr_char <= ASC("9") ) or *lexer.curr_char= ASC(".") )
         tmp_number += chr$(*lexer.curr_char)
         lexer.curr_char += 1
      wend
  
      lexer.token.type_ = TOKEN.TYPE.NUMBER
      lexer.token.value = val(tmp_number)
      exit sub
   end if  
  
   '' otherwise it must be one of the operators ( '(', ')', '*', '/', '+', '-', '^' )
   select case *lexer.curr_char
      case asc("("):
         lexer.token.type_ = TOKEN.TYPE.LPARA
      case asc(")"):
         lexer.token.type_ = TOKEN.TYPE.RPARA
      case asc("*"):
         lexer.token.type_ = TOKEN.TYPE.MUL
      case asc("/"):
         lexer.token.type_ = TOKEN.TYPE.DIV
      case asc("+"):
         lexer.token.type_ = TOKEN.TYPE.ADD
      case asc("-"):
         lexer.token.type_ = TOKEN.TYPE.SUB
      case asc("^"):
         lexer.token.type_ = TOKEN.TYPE.POW
   end select

   if( lexer.token.type_ <> TOKEN.TYPE.UNKNOWN ) then
      lexer.curr_char += 1
      exit sub
   end if

   '' otherwise we check wheter we got a keyword
   dim keyword as string
   while( (*lexer.curr_char <> asc(" ") and *lexer.curr_char <> 9 and *lexer.curr_char <> 0) and _
          (lcase$(*lexer.curr_char) >= "a" and lcase$(*lexer.curr_char) <= "z" ) )
      keyword += chr$(*lexer.curr_char)
      lexer.curr_char += 1
   wend

   select case UCASE$(keyword)
      case "SIN":
         lexer.token.type_ = TOKEN.TYPE.SIN
      case "COS":
         lexer.token.type_ = TOKEN.TYPE.COS
   end select

end sub


sub lexerTest()
   dim mathexpr as string

   line input "mathexpression:", mathexpr
   LexerInit mathexpr
   leX()

   while( lexer.token.type_ <> TOKEN.TYPE.EOS and lexer.token.type_ <> TOKEN.TYPE.UNKNOWN )
     select case lexer.token.type_
        case TOKEN.TYPE.ADD:
           print "TOKEN.TYPE.ADD ";
        case TOKEN.TYPE.SUB:
           print "TOKEN.TYPE.SUB ";
        case TOKEN.TYPE.MUL:
           print "TOKEN.TYPE.MUL ";
        case TOKEN.TYPE.DIV:
           print "TOKEN.TYPE.DIV ";
        case TOKEN.TYPE.POW:
           print "TOKEN.TYPE.POW ";
        case TOKEN.TYPE.LPARA:
           print "TOKEN.TYPE.LPARA ";
        case TOKEN.TYPE.RPARA:
           print "TOKEN.TYPE.RPARA ";
        case TOKEN.TYPE.NUMBER:
           print str$( lexer.token.value ) + " ";
     end select
     lex()
   wend

   if( lexer.token.type_ = TOKEN.TYPE.EOS ) then
      print " TOKEN.TYPE.EOS "
   else
      print " TOKEN.TYPE.UNKNOWN "
   end if
end sub


dim shared Parser.error as integer
dim shared Parser.errormsg as string


function mathParsergetErrorMsg() as string
   mathParserGetErrorMsg = Parser.errormsg
end function

function mathParser ( mathexpr as string, result as string) as integer
  
   dim res as double

   LexerInit mathexpr
   Parser.error = 0
   Parser.errormsg = ""
  
   lex()
   res = parAddExpr()
   result = str$(res)

   if( Parser.error ) then
      mathParser = 0
      exit function
   else
      mathParser = -1
      exit function
   end if

end function

function parAddExpr ( ) as double
  
   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parMulExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( +, - )?
   if( lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.ADD or lexer.token.type_ = TOKEN.TYPE.SUB )
         optype = lexer.token.type_
         lex()

         value2 = parMulExpr()
         if( Parser.error ) then exit function

         if( optype = TOKEN.TYPE.ADD ) then
            value1 += value2
         elseif( optype = TOKEN.TYPE.SUB ) then
            value1 -= value2
         end if
      wend
   end if

   parAddExpr = value1
  
end function

function parMulExpr ( ) as double

   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parNegExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( *, / )?
   if( lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.MUL or lexer.token.type_ = TOKEN.TYPE.DIV )
         optype = lexer.token.type_
         lex()

         value2 = parNegExpr()
         if( Parser.error ) then exit function

         if( optype = TOKEN.TYPE.MUL ) then
            value1 *= value2
         elseif( optype = TOKEN.TYPE.DIV ) then
            if( value2 = 0.0 ) then
               Parser.error = -1
               Parser.errormsg = "error: division by zero"
               exit function
            else
               value1 /= value2
            end if
         end if
      wend
   end if

   parMulExpr = value1
end function

function parNegExpr ( ) as double
   if( lexer.token.type_ = TOKEN.TYPE.SUB ) THEN
      lex()
      parNegExpr = -parExpExpr()
   elseif ( lexer.token.type_ = TOKEN.TYPE.ADD ) then
      lex()
      parNegExpr = parExpExpr()
   else
      parNegExpr = parExpExpr()
   end if
end function

function parExpExpr ( ) as double
   dim value1 as double
   dim value2 as double
   dim optype as TokenType
  
   '' get the left sided value
   value1 = parFuncExpr( )
   if( Parser.error ) then exit function

   '' do we have a valid operator ( *, / )?
   if( lexer.token.type_ = TOKEN.TYPE.POW ) then
  
      while(lexer.token.type_ = TOKEN.TYPE.POW )
         optype = lexer.token.type_
         lex()

         value2 = parFuncExpr()
         if( Parser.error ) then exit function
        
         value1 = value1 ^ value2
      wend
   end if

   parExpExpr = value1  
end function

function parFuncExpr ( ) as double

   select case lexer.token.type_
      case TOKEN.TYPE.SIN:
         lex()  
         parFuncExpr = sin( parParaExpr )
      case TOKEN.TYPE.COS:
         lex()
         parFuncExpr = cos( parParaExpr )
      case else
         parFuncExpr = parParaExpr()
   end select


end function

function parParaExpr ( ) as double

   dim value as double

   if( lexer.token.type_ = TOKEN.TYPE.LPARA ) then
      lex()

      value = parAddExpr()
      parParaExpr = value
      if( Parser.error = -1 ) then exit function

      if( lexer.token.type_ <> TOKEN.TYPE.RPARA ) then
         Parser.error = -1
         Parser.errormsg = "error: expected ')'"
         print "paraexpr: " + str$(lexer.token.type_)
         exit function
      end if
      lex()
   else
      parParaExpr = parAtom()
   end if


end function

function parAtom ( ) as double
   if( lexer.token.type_ <> TOKEN.TYPE.NUMBER ) then
      Parser.error = -1
      Parser.errormsg = "error: expected number"
   else
      parAtom = lexer.token.value
      lex()
   end if

end function


dim mathexpr as string
dim result as string

line input "enter math expression:" , mathexpr
if( mathParser( mathexpr, result ) = 0 ) then
   print mathParserGetErrorMsg()
else
   print "result is:" + result
end if

[jdebord]

I have tried to evaluate:

sin(0.1)^2 + cos(0.1)^2

This expression is accepted by marzecTM's parser (and is of course evaluated to 1), but with keeling's parser, I had to enter:

((sin(0.1))^2)+((cos(0.1)^2)

Is there a means to get rid of the extra parentheses ?