Deep Basic

[Zlatko Vid]

generated by Deep AI and me

Code Select Expand

' Basic interpreter with label-based control flow and multi-argument functions
'in Oxygen Basic code by Deep AI & Aurel

' Data structures
Type ProgramLine
    label As String
    code As String
End Type

Type UserFunction
    name As String
    params() As String
    body As String
End Type

' Globals
Dim program(1 To 500) As ProgramLine
Dim programSize As Integer
Dim labelMap As New Dictionary(Of String, Integer)
Dim variables(0 To 25) As Double ' A-Z
Dim functions() As UserFunction
Dim funcCount As Integer
Dim currentLine As Integer
Dim programRunning As Boolean

' Initialize
Sub InitProgram()
    programSize = 0
    labelMap.Clear()
    ReDim functions(1 To 50)
    funcCount = 0
End Sub

Sub AddLine(label As String, code As String)
    programSize += 1
    program(programSize).label = label
    program(programSize).code = code
    labelMap.Add(label.ToUpper(), programSize)
End Sub

Function FindLabel(label As String) As Integer
    Dim idx As Integer = -1
    If labelMap.ContainsKey(label.ToUpper()) Then
        idx = labelMap.Item(label.ToUpper())
    End If
    Return idx
End Function

' Tokenizer
Function Tokenize(expr As String) As String()
    Dim tokens() As String
    Dim p As Integer = 1
    Dim lenExpr As Integer = Len(expr)
    Dim tokenCount As Integer = 0
    While p <= lenExpr
        Dim ch As String = Mid(expr, p, 1)
        If ch = " " Then p += 1 : Continue
        If ch Like "[0-9.]" Then
            Dim startPos As Integer = p
            While p <= lenExpr And Mid(expr, p, 1) Like "[0-9.]"
                p += 1
            Wend
            tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
            tokens(tokenCount) = Mid(expr, startPos, p - startPos)
        ElseIf ch Like "[A-Za-z]" Then
            Dim startPos As Integer = p
            While p <= lenExpr And Mid(expr, p, 1) Like "[A-Za-z0-9]"
                p += 1
            Wend
            tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
            tokens(tokenCount) = UCase(Mid(expr, startPos, p - startPos))
        ElseIf ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Or ch = "(" Or ch = ")" Or ch = "=" Or ch = "," Then
            tokenCount += 1 : ReDim Preserve tokens(1 To tokenCount)
            tokens(tokenCount) = ch
            p += 1
        Else
            p += 1
        End If
    Wend
    Return tokens
End Function

' Expression parsing and evaluation (simple recursive descent)
Function ParseExpression(tokens() As String, ByRef pos As Integer) As Double
    Dim val1 As Double = ParseTerm(tokens, pos)
    While pos <= UBound(tokens) And (tokens(pos) = "+" Or tokens(pos) = "-")
        Dim op As String = tokens(pos)
        pos += 1
        Dim val2 As Double = ParseTerm(tokens, pos)
        If op = "+" Then val1 += val2 Else val1 -= val2
    Wend
    Return val1
End Function

Function ParseTerm(tokens() As String, ByRef pos As Integer) As Double
    Dim val1 As Double = ParseFactor(tokens, pos)
    While pos <= UBound(tokens) And (tokens(pos) = "*" Or tokens(pos) = "/")
        Dim op As String = tokens(pos)
        pos += 1
        Dim val2 As Double = ParseFactor(tokens, pos)
        If op = "*" Then val1 *= val2 Else If val2 <> 0 Then val1 /= val2
    Wend
    Return val1
End Function

Function ParseFactor(tokens() As String, ByRef pos As Integer) As Double
    Dim token As String = tokens(pos)
    Dim result As Double
    If IsNumeric(token) Then
        result = Val(token)
        pos += 1
    ElseIf token Like "[A-Z]" Then
        Dim idx As Integer = Asc(token) - Asc("A")
        result = variables(idx)
        pos += 1
    ElseIf token = "(" Then
        pos += 1
        result = ParseExpression(tokens, pos)
        If tokens(pos) = ")" Then pos += 1
    ElseIf tokens(pos) Like "[A-Za-z]" Then
        ' Function call
        result = CallFunction(token, tokens, pos)
    Else
        result = 0
        pos += 1
    End If
    Return result
End Function

' Call multi-arg function
Function CallFunction(funcName As String, tokens() As String, ByRef pos As Integer) As Double
    Dim args() As Double
    ReDim args(0 To -1)
    If tokens(pos) = "(" Then
        pos += 1 ' skip '('
        Do While tokens(pos) <> ")" And pos <= UBound(tokens)
            Dim argVal As Double = ParseExpression(tokens, pos)
            ReDim Preserve args(0 To UBound(args) + 1)
            args(UBound(args)) = argVal
            If tokens(pos) = "," Then pos += 1
        Loop
        If tokens(pos) = ")" Then pos += 1
        Return CallFunctionByName(funcName, args)
    Else
        ' no parentheses, no args
        Return CallFunctionByName(funcName, args)
    End If
End Function

Function CallFunctionByName(name As String, args() As Double) As Double
    Dim i As Integer
    For i = 1 To funcCount
        If functions(i).name = name Then
            Dim body As String = functions(i).body
            Dim params() As String = functions(i).params
            Dim pCount As Integer = UBound(params) - LBound(params) + 1
            If UBound(args) + 1 <> pCount Then Return 0 ' mismatch
            Dim tempBody As String = body
            For j As Integer = 0 To pCount - 1
                tempBody = Replace(tempBody, params(j), CStr(args(j)))
            Next
            Return EvaluateExpression(tempBody)
        End If
    Next
    Return 0
End Function

Function EvaluateExpression(expr As String) As Double
    Dim tokens() As String = Tokenize(expr)
    Dim p As Integer = 1
    Return ParseExpression(tokens, p)
End Function

' Execute a line of code
Sub ExecuteLine(line As String)
    Dim tokens() As String = Tokenize(line)
    If UBound(tokens) < 0 Then Return
    Dim cmd As String = tokens(1)
    Dim rest As String = Mid(line, Len(cmd) + 2).Trim()
    Select Case UCase(cmd)
        Case "PRINT"
            Print rest
        Case "LET"
            Dim eqPos As Integer = InStr(rest, "=")
            If eqPos > 0 Then
                Dim vname As String = Trim(Left(rest, eqPos - 1))
                Dim expr As String = Trim(Mid(rest, eqPos + 1))
                Dim valRes As Double = EvaluateExpression(expr)
                Dim idx As Integer = Asc(UCase(vname)) - Asc("A")
                variables(idx) = valRes
            End If
        Case "GOTO"
            Dim lbl As String = rest
            Dim idx As Integer = FindLabel(lbl)
            If idx >= 1 Then currentLine = idx - 1 ' -1 because main loop increments
        Case "IF"
            ' Format: IF expr THEN label
            Dim thenPos As Integer = InStr(UCase(line), "THEN")
            If thenPos > 0 Then
                Dim condExpr As String = Trim(Mid(line, 4, thenPos - 4))
                Dim lbl As String = Trim(Mid(line, thenPos + 4))
                Dim condVal As Double = EvaluateExpression(condExpr)
                If condVal <> 0 Then
                    Dim idx As Integer = FindLabel(lbl)
                    If idx >= 1 Then currentLine = idx - 1
                End If
            End If
        Case "DEF"
            ' Format: DEF FN name(params) = expression
            Dim defLine As String = line
            Dim eqPos As Integer = InStr(defLine, "=")
            If eqPos > 0 Then
                Dim defPart As String = Trim(Left(defLine, eqPos - 1))
                Dim body As String = Trim(Mid(defLine, eqPos + 1))
                Dim fnPos As Integer = InStr(defPart, "FN")
                If fnPos > 0 Then
                    Dim restStr As String = Trim(Mid(defPart, fnPos + 2))
                    Dim openP As Integer = InStr(restStr, "(")
                    Dim closeP As Integer = InStr(restStr, ")")
                    If openP > 0 And closeP > 0 Then
                        Dim fname As String = Trim(Left(restStr, openP - 1))
                        Dim paramStr As String = Trim(Mid(restStr, openP + 1, closeP - openP - 1))
                        Dim params() As String
                        If Len(paramStr) > 0 Then
                            params = Split(paramStr, ",")
                            For i As Integer = 0 To UBound(params)
                                params(i) = Trim(params(i))
                            Next
                        Else
                            ReDim params(0 To -1)
                        End If
                        If funcCount >= UBound(functions) Then Exit Sub
                        funcCount += 1
                        functions(funcCount).name = fname
                        functions(funcCount).params = params
                        functions(funcCount).body = body
                    End If
                End If
            End If
        ' Add more commands as needed
    End Select
End Sub

Sub RunProgram()
    currentLine = 1
    programRunning = True
    While currentLine >= 1 And currentLine <= programSize
        Dim line As String = program(currentLine).code
        ExecuteLine(line)
        currentLine += 1
    Wend
    Print "Program finished."
End Sub

Sub Main()
    InitProgram()
    ' Sample program
    AddLine("START", "LET A = 5")
    AddLine("LOOP", "PRINT ""A=""; A")
    AddLine("INCR", "LET A = A + 1")
    AddLine("CHECK", "IF A < 10 THEN GOTO LOOP")
    AddLine("END", "PRINT ""Done.""")
    RunProgram()
End Sub


[Zlatko Vid]

here is better version i hope 
you may try to compile but i doubt that will work

Code Select Expand

' Basic-like interpreter with fixed-size global arrays, no dynamic Redim
' No dictionaries used; labels stored in parallel arrays

' Constants for maximum sizes
CONST MAX_PROGRAM_LINES = 1000
CONST MAX_FUNCTIONS = 50
CONST MAX_PARAMS = 10
CONST MAX_LABELS = 100

' Data structures
TYPE ProgramLine
    label As String * 20
    code As String * 80
END TYPE

TYPE UserFunction
    name As String * 20
    params(0 To MAX_PARAMS - 1) As String * 10
    paramCount As Integer
    body As String * 80
END TYPE

' Global arrays
DIM program(1 To MAX_PROGRAM_LINES) AS ProgramLine
DIM labels(1 To MAX_LABELS) AS String * 20
DIM labelLines(1 To MAX_LABELS) AS Integer
Dim labelCount As Integer

DIM functions(1 To MAX_FUNCTIONS) AS UserFunction
Dim funcCount As Integer

Dim variables(0 To 25) As Double ' A-Z variables

Dim progCount As Integer
Dim currentLine As Integer

Sub Init()
    ' Initialize counters
    progCount = 0
    labelCount = 0
    funcCount = 0
   
    ' Optional: clear arrays (not strictly necessary)
    Dim i As Integer
    For i = 1 To MAX_PROGRAM_LINES
        program(i).label = ""
        program(i).code = ""
    Next
    For i = 1 To MAX_LABELS
        labels(i) = ""
        labelLines(i) = 0
    Next
    For i = 1 To MAX_FUNCTIONS
        functions(i).name = ""
        functions(i).body = ""
        functions(i).paramCount = 0
        For j = 0 To MAX_PARAMS - 1
            functions(i).params(j) = ""
        Next
    Next
End Sub

Sub AddLine(label As String, code As String)
    If progCount >= MAX_PROGRAM_LINES Then Exit Sub
    progCount += 1
    program(progCount).label = label
    program(progCount).code = code
    If label <> "" And labelCount < MAX_LABELS Then
        labelCount += 1
        labels(labelCount) = UCase(label)
        labelLines(labelCount) = progCount
    End If
End Sub

Function FindLabel(lbl As String) As Integer
    Dim i As Integer
    For i = 1 To labelCount
        If labels(i) = UCase(lbl) Then
            Return labelLines(i)
        End If
    Next
    Return -1
End Function

Function ParseTokens(line As String) As String()
    Dim tokens(1 To 100) As String
    Dim tokenCount As Integer
    tokenCount = 0
    Dim p As Integer
    p = 1
    Dim lenLine As Integer
    lenLine = Len(line)
    While p <= lenLine
        Dim ch As String
        ch = Mid(line, p, 1)
        If ch = " " Then
            p = p + 1
            Continue
        End If
        If ch Like "[0-9.]" Then
            Dim startPos As Integer
            startPos = p
            While p <= lenLine And Mid(line, p, 1) Like "[0-9.]"
                p = p + 1
            Wend
            tokenCount = tokenCount + 1
            tokens(tokenCount) = Mid(line, startPos, p - startPos)
        ElseIf ch Like "[A-Za-z]" Then
            Dim startPos As Integer
            startPos = p
            While p <= lenLine And Mid(line, p, 1) Like "[A-Za-z0-9]"
                p = p + 1
            Wend
            tokenCount = tokenCount + 1
            tokens(tokenCount) = UCase(Mid(line, startPos, p - startPos))
        ElseIf ch = "(" Or ch = ")" Or ch = "," Or ch = "=" Or ch = "+" Or ch = "-" Or ch = "*" Or ch = "/" Then
            tokenCount = tokenCount + 1
            tokens(tokenCount) = ch
            p = p + 1
        Else
            p = p + 1
        End If
    Wend
    ParseTokens = tokens
End Function

Function EvaluateExpression(tokens() As String, ByRef pos As Integer) As Double
    Dim val1 As Double = ParseTerm(tokens, pos)
    While pos <= UBound(tokens) And (tokens(pos) = "+" Or tokens(pos) = "-")
        Dim op As String
        op = tokens(pos)
        pos = pos + 1
        Dim val2 As Double
        val2 = ParseTerm(tokens, pos)
        If op = "+" Then
            val1 = val1 + val2
        Else
            val1 = val1 - val2
        End If
    Wend
    EvaluateExpression = val1
End Function

Function ParseTerm(tokens() As String, ByRef pos As Integer) As Double
    Dim val1 As Double = ParseFactor(tokens, pos)
    While pos <= UBound(tokens) And (tokens(pos) = "*" Or tokens(pos) = "/")
        Dim op As String
        op = tokens(pos)
        pos = pos + 1
        Dim val2 As Double
        val2 = ParseFactor(tokens, pos)
        If op = "*" Then
            val1 = val1 * val2
        ElseIf val2 <> 0 Then
            val1 = val1 / val2
        End If
    Wend
    ParseTerm = val1
End Function

Function ParseFactor(tokens() As String, ByRef pos As Integer) As Double
    Dim token As String
    token = tokens(pos)
    Dim result As Double
    If IsNumeric(token) Then
        result = Val(token)
        pos = pos + 1
    ElseIf token Like "[A-Z]" Then
        ' Variable
        result = variables(Asc(token) - Asc("A"))
        pos = pos + 1
    ElseIf token = "(" Then
        pos = pos + 1
        result = EvaluateExpression(tokens, pos)
        If tokens(pos) = ")" Then pos = pos + 1
    Else
        result = 0
        pos = pos + 1
    End If
    ParseFactor = result
End Function

Function CallFunction(name As String, tokens() As String, ByRef pos As Integer) As Double
    Dim args(0 To MAX_PARAMS - 1) As Double
    Dim argCount As Integer
    argCount = 0
    If tokens(pos) = "(" Then
        pos = pos + 1
        Do While tokens(pos) <> ")" And pos <= UBound(tokens)
            args(argCount) = EvaluateExpression(tokens, pos)
            argCount = argCount + 1
            If tokens(pos) = "," Then pos = pos + 1
        Loop
        If tokens(pos) = ")" Then pos = pos + 1
        CallFunction = CallUserFunction(name, args, argCount)
    Else
        ' no parentheses, no args
        CallFunction = CallUserFunction(name, args, 0)
    End If
End Function

Function CallUserFunction(name As String, args() As Double, argCount As Integer) As Double
    Dim i As Integer
    For i = 1 To funcCount
        If functions(i).name = name Then
            Dim body As String = functions(i).body
            Dim p As Integer
            p = 1
            Dim tempBody As String
            tempBody = body
            Dim j As Integer
            For j = 0 To functions(i).paramCount - 1
                Dim paramName As String = functions(i).params(j)
                tempBody = Replace(tempBody, paramName, CStr(args(j)))
            Next
            Dim tokens() As String
            tokens = ParseTokens(tempBody)
            Return EvaluateExpression(tokens, p)
        End If
    Next
    Return 0
End Function

Sub ExecuteLine(line As String)
    Dim tokens() As String
    tokens = ParseTokens(line)
    If UBound(tokens) < 1 Then Exit Sub
    Dim firstToken As String
    firstToken = tokens(1)
    Select Case firstToken
        Case "PRINT"
            Dim expr As String
            expr = Mid(line, Len("PRINT") + 2)
            Dim tokensExpr() As String
            tokensExpr = ParseTokens(expr)
            Dim pos As Integer
            pos = 1
            Dim val As Double
            val = EvaluateExpression(tokensExpr, pos)
            Print val
        Case "LET"
            ' Format: LET A = expression
            Dim eqPos As Integer
            eqPos = InStr(line, "=")
            If eqPos > 0 Then
                Dim varPart As String
                varPart = Trim(Left(line, eqPos - 1))
                Dim varName As String
                varName = Trim(Mid(varPart, Len("LET") + 1))
                Dim expr As String
                expr = Trim(Mid(line, eqPos + 1))
                Dim tokensExpr() As String
                tokensExpr = ParseTokens(expr)
                Dim pos As Integer
                pos = 1
                Dim val As Double
                val = EvaluateExpression(tokensExpr, pos)
                If varName Like "[A-Z]" Then
                    variables(Asc(varName) - Asc("A")) = val
                End If
            End If
        Case "GOTO"
            Dim lbl As String
            lbl = Trim(Mid(line, Len("GOTO") + 2))
            Dim idx As Integer
            idx = FindLabel(lbl)
            If idx >= 1 Then currentLine = idx - 1
        Case "IF"
            Dim thenPos As Integer
            thenPos = InStr(UCase(line), "THEN")
            If thenPos > 0 Then
                Dim condPart As String
                condPart = Trim(Left(line, thenPos - 1))
                Dim lbl As String
                lbl = Trim(Mid(line, thenPos + 4))
                Dim condExpr As String
                condExpr = Trim(Mid(condPart, 3))
                Dim tokensCond() As String
                tokensCond = ParseTokens(condExpr)
                Dim pos As Integer
                pos = 1
                Dim condVal As Double
                condVal = EvaluateExpression(tokensCond, pos)
                If condVal <> 0 Then
                    Dim idx As Integer
                    idx = FindLabel(lbl)
                    If idx >= 1 Then currentLine = idx - 1
                End If
            End If
        Case "DEF"
            ' DEF FN name(params)=expression
            Dim defLine As String
            defLine = line
            Dim eqPos As Integer
            eqPos = InStr(defLine, "=")
            If eqPos > 0 Then
                Dim defPart As String
                defPart = Trim(Left(defLine, eqPos - 1))
                Dim body As String
                body = Trim(Mid(defLine, eqPos + 1))
                Dim fnPos As Integer
                fnPos = InStr(defPart, "FN")
                If fnPos > 0 Then
                    Dim restStr As String
                    restStr = Trim(Mid(defPart, fnPos + 2))
                    Dim openP As Integer
                    Dim closeP As Integer
                    openP = InStr(restStr, "(")
                    closeP = InStr(restStr, ")")
                    If openP > 0 And closeP > 0 Then
                        Dim fname As String
                        fname = Trim(Left(restStr, openP - 1))
                        Dim paramStr As String
                        paramStr = Trim(Mid(restStr, openP + 1, closeP - openP - 1))
                        Dim params() As String
                        Dim paramCount As Integer
                        paramCount = 0
                        If Len(paramStr) > 0 Then
                            Dim arrParams() As String
                            arrParams = Split(paramStr, ",")
                            For j = 0 To UBound(arrParams)
                                functions(funcCount + 1).params(j) = Trim(arrParams(j))
                            Next
                            paramCount = UBound(arrParams) + 1
                        End If
                        If funcCount < MAX_FUNCTIONS Then
                            funcCount = funcCount + 1
                            functions(funcCount).name = fname
                            functions(funcCount).body = body
                            functions(funcCount).paramCount = paramCount
                        End If
                    End If
                End If
            End If
        ' Add other commands as needed
    End Select
End Sub

Sub RunProgram()
    currentLine = 1
    While currentLine >= 1 And currentLine <= progCount
        Dim line As String
        line = program(currentLine).code
        ExecuteLine(line)
        currentLine = currentLine + 1
    Wend
    Print "Program finished."
End Sub

Sub Main()
    Init()
    ' Example program:
    ' Define a function: FN Add(a,b) = a + b
    AddLine("", "DEF FN Add(a,b)=a+b")
    AddLine("", "LET A=10")
    AddLine("", "LET B=20")
    AddLine("", "PRINT ""Sum=""")
    AddLine("", "PRINT FN Add(A,B)")
    AddLine("", "IF A<B THEN GOTO Label1")
    AddLine("Label1", "PRINT ""A is less than B""")
    RunProgram()
End Sub

[Zlatko Vid]

..i must say that i am very stupid for console programs   
but here is how look...

 

[Zlatko Vid]

..and here is code if you want to try o2v604

Code Select Expand

Deep Basic v1 in o2 /QB code by DeepAI /mod by Aurel
uses console
'Global block
Declare SUB RunProgram(lines() AS STRING)
Declare FUNCTION FindLabel(label as string ) AS INT
Declare FUNCTION EvalExpression(expr As STRING) AS FLOAT
Declare FUNCTION ParseTerm() AS FLOAT
Declare FUNCTION ParseFactor() AS FLOAT
Declare FUNCTION GetNextToken() AS STRING
Declare SUB SkipWhitespace()
'print " compiled ...OK!"

Dim Lines[1024] AS STRING
Dim Labels[1024] AS STRING
Dim LabelLine[1024] AS INT

Dim LineCount AS INT
Dim PC AS INT ' Program Counter
Dim Stack[128] AS INT
Dim StackPtr AS INT

Dim Variables[100] AS STRING
Dim VariablesVal[100] AS FLOAT

Dim Token as STRING : Dim TokenPos AS INT
Dim CurrentToken AS STRING
Dim Expr AS STRING

'input block i guess...
PRINT "Enter your BASIC program line by line." + cr
PRINT "End with a line containing just 'END'"
'show in console ...hmm i am not used to console programs?
Waitkey
CLS