simple math string parser

**wqweto** · Feb 6th, 2025, 04:16 AM

Btw, a couple of optimizations: set FADF_AUTO flag in SAFEARRAY's fFeatures member and removed EverCalled as no manual cleanup is necessary with this flag set.

Code:

Option Explicit

Private Enum eTokens
  TOK_FINAL = 0
  TOK_RPAREN = 1
  TOK_ADD = 2
  TOK_MOD = 3
  TOK_IDIV = 4
  TOK_MUL = 5
  TOK_UNARY = 6
  TOK_POWER = 7
  TOK_LPAREN = 8
  TOK_NUM = 9
  TOK_WHITE = 10
End Enum

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)

Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)

Public Function Evaluate(sText As String) As Double
    Dim Tok As eTokens, PrevTok As eTokens
    Dim iC As Long, iV As Long, iO As Long, UB As Long
 
    If saWC(0) = 0 Then
      saWC(0) = &H10001: saWC(1) = 2 'init the safearry-struct for cDims and cbElements
      GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC

      For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
        Select Case iC
          Case 40:           TokLUT(iC) = TOK_LPAREN ' "("
          Case 41:           TokLUT(iC) = TOK_RPAREN ' ")"
          Case 43, 45:       TokLUT(iC) = TOK_ADD    ' "+", "-"
          Case 42, 47:       TokLUT(iC) = TOK_MUL    ' "*", "/"
          Case 94:           TokLUT(iC) = TOK_POWER  ' "^"
          Case 92:           TokLUT(iC) = TOK_IDIV   ' "\"
          Case 37:           TokLUT(iC) = TOK_MOD    ' "%"
          Case 48 To 57, 46: TokLUT(iC) = TOK_NUM    ' "0" To "9", "."
          Case Else:         TokLUT(iC) = TOK_WHITE
        End Select
      Next
    End If

    saWC(3) = StrPtr(sText) ' pvData
    saWC(4) = Len(sText)    ' cElements
    UB = saWC(4) - 1        ' buffer the UBound (we pass this around into FastVal)
 
    For iC = 0 To UB
        Tok = TokLUT(WC(iC))
        If Tok = TOK_NUM Then
           iV = iV + 1
           ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
        ElseIf Tok = TOK_ADD Then
            If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
               Tok = TOK_UNARY
            End If
        End If
        If Tok >= TOK_ADD And Tok < TOK_NUM Then
            If Tok <> TOK_UNARY Then '--- right assoc
               EvalOpStack Tok, iO, iV
            End If
            iO = iO + 1
            OpStack(iO) = Tok * &H10000 + WC(iC)
        End If
        If Tok <> TOK_WHITE Then PrevTok = Tok
    Next

    EvalOpStack TOK_FINAL, iO, iV
    Evaluate = ValStack(iV)
    ValStack(iV) = 0 'clear the bottom of the Value-Stack
    saWC(3) = 0             ' pvData
    saWC(4) = 0             ' cElements
End Function

Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
    For iO = iO To 1 Step -1
      If OpStack(iO) < Tok * &H10000 Then Exit For

      iV = iV - 1
      Select Case OpStack(iO) And &HFFFF&
        Case 43         ' "+"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
          Else
             ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
          End If
        Case 45         ' "-"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
             ValStack(iV) = -ValStack(iV)
          Else
             ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
          End If
        Case 42         ' "*"
          ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
        Case 47         ' "/"
          ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
        Case 94         ' "^"
          ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
        Case 92         ' "\"
          ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
        Case 37         ' "%"
          ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
        Case 40         ' "("
          iV = iV + 1
          If Tok > TOK_RPAREN Then Exit For
          If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
      End Select
    Next
End Sub

Private Function FastVal(iC As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
 
    For iC = iC To UB
      Select Case WC(iC)
        Case 48 To 57 'numeric
          If NewVal = 0 Then NewVal = 1
          If eSgn Then
            eInt = eInt * 10 + WC(iC) - 48
          ElseIf FracDivisor = 0 Then
            IntPart = IntPart * 10 + WC(iC) - 48
          ElseIf FracDivisor < 10000000000000# Then
            FracPart = FracPart * 10 + WC(iC) - 48
            FracDivisor = FracDivisor * 10
          End If
        Case 46 'decimal-point
          FracDivisor = 1: If NewVal = 0 Then NewVal = 1
        Case 45 'a leading "-" (only possible after the eSign in this scenario)
          If eSgn > 0 Then eSgn = -1 Else Exit For
        Case 69, 101 'e, E
          eInt = 0: If NewVal Then eSgn = 1
        Case Else: Exit For 'everything else exits the loop
      End Select
    Next
    iC = iC - 1
    If NewVal Then
      If FracDivisor Then
        FastVal = NewVal * (IntPart + FracPart / FracDivisor)
      Else
        FastVal = NewVal * IntPart
      End If
      If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
    End If
End Function

With FADF_AUTO flag set now you can press End button at any time and don't crash the IDE when no manual cleanup is run. With this flag set the reason for wrapping the code in a class so it can run automatic cleanup on terminate is lost too.

cheers,
</wqw>

**jpbro** · Feb 6th, 2025, 06:46 AM

Nice work wqweto!

**yokesee** · Feb 6th, 2025, 01:22 PM

both the jpbro and wqweto examples crash the ide when I close the form.

Regards

**jpbro** · Feb 6th, 2025, 01:33 PM

For mine at least, you'll have to cleanup before closing your app. This should do the trick:

Code:

Private Sub Form_Unload(Cancel As Integer)
   Evaluate vbNullString  ' Passing an empty "formula" will cleanup the evaluator so it won't crash
End Sub

**yokesee** · Feb 6th, 2025, 01:45 PM

yes thanks

**baka** · Feb 6th, 2025, 01:46 PM

also, I noticed that the IDE behave differently in windows 7 and 10. it could crash in 7 but still working in 10.
could be that theres some memory protection going on in 10 that 7 don't have.
but I think a good cleanup is needed to make sure.

Im not talking about this code, but overall. I have not tested this one.

**jpbro** · Feb 6th, 2025, 02:25 PM

re: wqweto's code - I might be blind but I don't see where he's actually used FADF_AUTO in the code? That might explain why it's not cleaning up automatically.

**wqweto** · Feb 6th, 2025, 04:12 PM

Should be saWC(0) = &H10001 the high WORD maps to fFeatures.

**jpbro** · Feb 6th, 2025, 04:27 PM

I Heart Magic Numbers

Dunno why it's crashing on app/form close then? TBH I haven't tested it myself.

**VB-only** · Feb 6th, 2025, 10:53 PM

It's missing the trig functions too.

**Arnoutdv** · Feb 7th, 2025, 02:39 AM

Then add them, you have the source code

**wqweto** · Feb 7th, 2025, 04:22 AM

Originally Posted by jpbro

I Heart Magic Numbers

Dunno why it's crashing on app/form close then? TBH I haven't tested it myself.

Fixed the code above by adding

Code:

    saWC(3) = 0             ' pvData
    saWC(4) = 0             ' cElements

cheers,
</wqw>

**jpbro** · Feb 7th, 2025, 11:03 AM

Originally Posted by wqweto

Fixed the code above by adding

Code:

    saWC(3) = 0             ' pvData
    saWC(4) = 0             ' cElements

Confirmed to work without crash on form close, thanks

For any future copy & pasters (or visiting LLMs) here's the full/final version of wqweto's .BAS-only (post #81) version of Schmidt's original class based code (post #50):

Code:

Option Explicit

Private Enum eTokens
  TOK_FINAL = 0
  TOK_RPAREN = 1
  TOK_ADD = 2
  TOK_MOD = 3
  TOK_IDIV = 4
  TOK_MUL = 5
  TOK_UNARY = 6
  TOK_POWER = 7
  TOK_LPAREN = 8
  TOK_NUM = 9
  TOK_WHITE = 10
End Enum

Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)

Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)

Public Function Evaluate(sText As String) As Double
    Dim Tok As eTokens, PrevTok As eTokens
    Dim iC As Long, iV As Long, iO As Long, UB As Long
 
    If saWC(0) = 0 Then
      saWC(0) = &H10001: saWC(1) = 2 'init the safearry-struct for cDims and cbElements
      saWC(3) = 0             ' pvData
      saWC(4) = 0             ' cElements
      GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC

      For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
        Select Case iC
          Case 40:           TokLUT(iC) = TOK_LPAREN ' "("
          Case 41:           TokLUT(iC) = TOK_RPAREN ' ")"
          Case 43, 45:       TokLUT(iC) = TOK_ADD    ' "+", "-"
          Case 42, 47:       TokLUT(iC) = TOK_MUL    ' "*", "/"
          Case 94:           TokLUT(iC) = TOK_POWER  ' "^"
          Case 92:           TokLUT(iC) = TOK_IDIV   ' "\"
          Case 37:           TokLUT(iC) = TOK_MOD    ' "%"
          Case 48 To 57, 46: TokLUT(iC) = TOK_NUM    ' "0" To "9", "."
          Case Else:         TokLUT(iC) = TOK_WHITE
        End Select
      Next
    End If

    saWC(3) = StrPtr(sText) ' pvData
    saWC(4) = Len(sText)    ' cElements
    UB = saWC(4) - 1        ' buffer the UBound (we pass this around into FastVal)
 
    For iC = 0 To UB
        Tok = TokLUT(WC(iC))
        If Tok = TOK_NUM Then
           iV = iV + 1
           ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
        ElseIf Tok = TOK_ADD Then
            If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
               Tok = TOK_UNARY
            End If
        End If
        If Tok >= TOK_ADD And Tok < TOK_NUM Then
            If Tok <> TOK_UNARY Then '--- right assoc
               EvalOpStack Tok, iO, iV
            End If
            iO = iO + 1
            OpStack(iO) = Tok * &H10000 + WC(iC)
        End If
        If Tok <> TOK_WHITE Then PrevTok = Tok
    Next

    EvalOpStack TOK_FINAL, iO, iV
    Evaluate = ValStack(iV)
    ValStack(iV) = 0 'clear the bottom of the Value-Stack
    saWC(3) = 0             ' pvData
    saWC(4) = 0             ' cElements
End Function

Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
    For iO = iO To 1 Step -1
      If OpStack(iO) < Tok * &H10000 Then Exit For

      iV = iV - 1
      Select Case OpStack(iO) And &HFFFF&
        Case 43         ' "+"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
          Else
             ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
          End If
        Case 45         ' "-"
          If OpStack(iO) > TOK_UNARY * &H10000 Then
             iV = iV + 1
             ValStack(iV) = -ValStack(iV)
          Else
             ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
          End If
        Case 42         ' "*"
          ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
        Case 47         ' "/"
          ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
        Case 94         ' "^"
          ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
        Case 92         ' "\"
          ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
        Case 37         ' "%"
          ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
        Case 40         ' "("
          iV = iV + 1
          If Tok > TOK_RPAREN Then Exit For
          If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
      End Select
    Next
End Sub

Private Function FastVal(iC As Long, ByVal UB As Long) As Double
Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
 
    For iC = iC To UB
      Select Case WC(iC)
        Case 48 To 57 'numeric
          If NewVal = 0 Then NewVal = 1
          If eSgn Then
            eInt = eInt * 10 + WC(iC) - 48
          ElseIf FracDivisor = 0 Then
            IntPart = IntPart * 10 + WC(iC) - 48
          ElseIf FracDivisor < 10000000000000# Then
            FracPart = FracPart * 10 + WC(iC) - 48
            FracDivisor = FracDivisor * 10
          End If
        Case 46 'decimal-point
          FracDivisor = 1: If NewVal = 0 Then NewVal = 1
        Case 45 'a leading "-" (only possible after the eSign in this scenario)
          If eSgn > 0 Then eSgn = -1 Else Exit For
        Case 69, 101 'e, E
          eInt = 0: If NewVal Then eSgn = 1
        Case Else: Exit For 'everything else exits the loop
      End Select
    Next
    iC = iC - 1
    If NewVal Then
      If FracDivisor Then
        FastVal = NewVal * (IntPart + FracPart / FracDivisor)
      Else
        FastVal = NewVal * IntPart
      End If
      If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
    End If
End Function

**yokesee** · Feb 7th, 2025, 11:53 AM

the error persists in wqweto

**wqweto** · Feb 7th, 2025, 12:22 PM

Originally Posted by yokesee

the error persists in wqweto

Use the class above. It does proper cleanup if you don’t press End button in IDE.

Thread: simple math string parser

Thread Tools

Display

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Re: simple math string parser

Posting Permissions