Whats More Flexible Than An Overloaded Routine?

[bplus]

Perhaps a self parsing routine:

Here is Eval_Overload (which is not really an overloaded routine, like I said it's more flexible than that!)

Here is a sample of Inputs and Outputs this thing can do:
   

I think I've commented code enough for you to figure out how it works:

Code: (Select All)

Option _Explicit
_Title "Eval_Overload test" ' bplus revisit 2023-11-13 qB64pe v3.8
' 2023-11-13 dust off and cleanup this masterpiece

' original notes:
' testing with QB64 X 64 version 1.2 20180228/86  from git b301f92

'Overload test eval.bas B+ 2018-08-25 started
' modify Split for special case of spaces to be used as delimiter for overloaded p$ = parameter string

' note: for ease of coding ~ is used for subtraction sign
' and normal - is reserved to indicate a negative number.

Const WW = 800
Const WH = 600
Screen _NewImage(WW, WH, 32)
_ScreenMove 250, 60

Dim test$(1 To 5), i
test$(1) = "seven=7 eval>seven*10~7" ' < this is 7*10-7 = 63
test$(2) = "A=2 b=3 C=5 x=10 eval>a*X^2+B*x~c" ' 225
test$(3) = "eval>able*x^2+baker*x~charlie able=2 baker=2.99 charlie=5 x=10" ' 224.9
test$(4) = "seven=7" ' error no EVAL>
test$(5) = "eval>able*x^2+baker*x~charlie able=2 charlie=5 x=10" ' error missing baker

For i = 1 To 5
    Print "For: " + Chr$(34) + test$(i) + Chr$(34)
    Eval_Overload test$(i)
    Print "Eval_Overload returned: "; test$(i)
    Print
Next

Sub Eval_Overload (PL As String)
    ' PL comes in as parameters list, goes out like a function's return value
    ' (but in string form of course), so make copy of PL if you think you will need
    ' later. PS This is not overloading so much as it is Parsing the Argument String, PL,
    ' in my opinion making it even more fexible than Overloaded routine.

    ' Note: PL is space delimited like words in a sentence.
    ' The expression to Evaluate must be written to right of Eval> eg, Eval>expression
    ' No spaces! in this "word". For all variables used in the expression create
    ' VariableName=Value "words".

    ' While this EVAL function does not do parenthesis it does do operations
    ' in the following order:  %^/*~+   % is for modulus, ~ is for subtraction.
    '
    ' This Sub requires 2 Functions and a Sub:
    ' 1. Function leftOf$ (source$, of$)
    ' 2. Function rightOf$ (source$, of$)
    ' 1. Sub Split (SplitMeString As String, delim As String, LoadMe() As String)

    Dim pList$(0) ' <<< NOT REDIM???? split did not squawk about trying to redim this???
    Dim As Long i, L, R, found, hit
    Dim As Long found2, j, place, vl, vr
    Dim p$, this$, b$, wd$, op$, lb$, rb$, head$, tail$, M$
    p$ = UCase$(PL)
    Split p$, " ", pList$()
    For i = 0 To UBound(pList$) 'find eval
        If InStr(pList$(i), "EVAL>") Then
            this$ = rightOf$(pList$(i), "EVAL>"): found = 1: Exit For
        End If
    Next
    If found = 0 Or this$ = "" Then
        PL = "ERROR: Did not find eval or what to eval.": Exit Sub
    End If
    b$ = ""
    For i = 1 To Len(this$) 'do substitutions
        wd$ = ""
        hit = 0
        While InStr("ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid$(this$, i, 1)) And i <= Len(this$)
            hit = 1
            wd$ = wd$ + Mid$(this$, i, 1)
            i = i + 1
        Wend
        If hit Then i = i - 1
        If wd$ <> "" Then
            found2 = 0
            For j = 0 To UBound(pList$) 'find eval
                If leftOf$(pList$(j), "=") = wd$ Then
                    b$ = b$ + rightOf$(pList$(j), "="): found2 = 1: Exit For
                End If
            Next
            If found2 = 0 Then
                PL = "ERROR: Did not find variable, " + Chr$(34) + wd$ + Chr$(34) + ", in paramters list."
                Exit Sub
            End If
        Else
            b$ = b$ + Mid$(this$, i, 1)
        End If
    Next

    For j = 1 To 6
        op$ = Mid$("%^/*~+", j, 1) 'notice the strange sign for minus,
        ' it is to distinguish a neg number from subtraction op
        While InStr(b$, op$)
            place = InStr(b$, op$)
            L = place - 1: R = place + 1: lb$ = "": rb$ = ""
            While InStr("1234567890-.", Mid$(b$, L, 1)) And L >= 1
                lb$ = Mid$(b$, L, 1) + lb$
                L = L - 1
            Wend
            R = place + 1
            While InStr("1234567890-.", Mid$(b$, R, 1)) And R <= Len(b$)
                rb$ = rb$ + Mid$(b$, R, 1)
                R = R + 1
            Wend
            vl = Val(lb$): vr = Val(rb$)
            head$ = Mid$(b$, 1, L): tail$ = Mid$(b$, R)
            Select Case op$
                Case "%": M$ = LTrim$(Str$(Val(lb$) Mod Val(rb$)))
                Case "^": M$ = LTrim$(Str$(Val(lb$) ^ Val(rb$)))
                Case "/": M$ = LTrim$(Str$(Val(lb$) / Val(rb$)))
                Case "*": M$ = LTrim$(Str$(Val(lb$) * Val(rb$)))
                Case "~": M$ = LTrim$(Str$(Val(lb$) - Val(rb$)))
                Case "+": M$ = LTrim$(Str$(Val(lb$) + Val(rb$)))
            End Select
            b$ = head$ + M$ + tail$
        Wend 'while op instr
    Next

    'return PL with the evaluation substituted back into PL
    PL = b$
End Sub

Function leftOf$ (source$, of$)
    Dim As Long posOf
    posOf = InStr(source$, of$)
    If posOf > 0 Then leftOf$ = Mid$(source$, 1, posOf - 1)
End Function

Function rightOf$ (source$, of$)
    Dim As Long posOf
    posOf = InStr(source$, of$)
    If posOf > 0 Then rightOf$ = Mid$(source$, posOf + Len(of$))
End Function

' using updated split
Sub Split (SplitMeString As String, delim As String, LoadMe() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(LoadMe): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        LoadMe(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(LoadMe) Then
            ReDim _Preserve LoadMe(LBound(LoadMe) To UBound(LoadMe) + 1000) As String
        End If
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    LoadMe(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve LoadMe(LBound(LoadMe) To arrpos) As String 'get the ubound correct
End Sub