Untitled

 avatar
unknown
plain_text
a month ago
6.4 kB
5
Indexable
#include "crt.bi"
Const MAX_FUNCS = 20
Const MAX_ARGS = 5
Type FunctorDef
name As String
args(MAX_ARGS) As String
argCount As Integer
body As String
End Type
Dim Shared functions(MAX_FUNCS) As FunctorDef
Dim Shared funcCount As Integer = 0
' --- Helper Function Declarations ---
Declare Function ReplaceString(source As String, target As String, replacement As String) As String
Declare Function EvalExpr(expr As String) As Integer
Declare Function ExecuteFunc(funcName As String, passedArgs() As Integer, argCount As Integer) As Integer
Declare Sub ParseCode(code As String)
Declare Sub SplitArgs(argsStr As String, outArgs() As String, ByRef count As Integer)
' --- Helper: Replace Substring ---
Function ReplaceString(source As String, target As String, replacement As String) As String
Dim As String result = ""
Dim As Integer i = 1, tLen = Len(target)
If tLen = 0 Then Return source
While i <= Len(source)
If Mid(source, i, tLen) = target Then
' Check boundary to avoid partial variable name matches (e.g., matching "x" in "max")
Dim As Boolean match = True
If i > 1 Then
Dim As Integer charBefore = Asc(Mid(source, i - 1, 1))
If (charBefore >= 65 And charBefore <= 90) Or (charBefore >= 97 And charBefore <= 122) Or charBefore = 95 Then match = False
End If
If i + tLen <= Len(source) Then
Dim As Integer charAfter = Asc(Mid(source, i + tLen, 1))
If (charAfter >= 65 And charAfter <= 90) Or (charAfter >= 97 And charAfter <= 122) Or (charAfter >= 48 And charAfter <= 57) Or charAfter = 95 Then match = False
End If
If match Then
result &= replacement
i += tLen
Else
result &= Mid(source, i, 1)
i += 1
End If
Else
result &= Mid(source, i, 1)
i += 1
End If
Wend
Return result
End Function
' --- Helper: Split Arguments safely by Comma ---
Sub SplitArgs(argsStr As String, outArgs() As String, ByRef count As Integer)
count = 0
Dim As String current = ""
Dim As Integer depth = 0
For i As Integer = 1 To Len(argsStr)
Dim As String c = Mid(argsStr, i, 1)
If c = "," And depth = 0 Then
outArgs(count) = Trim(current)
count += 1
current = ""
Else
If c = "(" Then depth += 1
If c = ")" Then depth -= 1
current &= c
End If
Next
If Trim(current) <> "" Then
outArgs(count) = Trim(current)
count += 1
End If
End Sub
' --- Parser ---
Sub ParseCode(code As String)
Dim As Integer pos1 = 1, pos2
While pos1 <= Len(code)
pos1 = InStr(pos1, code, "func ")
If pos1 = 0 Then Exit While
pos1 += 5
pos2 = InStr(pos1, code, "(")
Dim As String fName = Trim(Mid(code, pos1, pos2 - pos1))
pos1 = pos2 + 1
pos2 = InStr(pos1, code, ")")
Dim As String argsStr = Trim(Mid(code, pos1, pos2 - pos1))
pos1 = InStr(pos2, code, "{") + 1
pos2 = InStr(pos1, code, "}")
Dim As String bodyStr = Trim(Mid(code, pos1, pos2 - pos1))
' Store function metadata
functions(funcCount).name = fName
functions(funcCount).body = bodyStr
' Parse parameters
Dim As String rawArgs(MAX_ARGS)
Dim As Integer aCount = 0
SplitArgs(argsStr, rawArgs(), aCount)
functions(funcCount).argCount = aCount
For i As Integer = 0 To aCount - 1
functions(funcCount).args(i) = rawArgs(i)
Next
funcCount += 1
pos1 = pos2 + 1
Wend
End Sub
' --- Recursive Expression Evaluator ---
Function EvalExpr(expr As String) As Integer
expr = Trim(expr)
' Handle Built-in Print Function
If Left(expr, 6) = "print(" And Right(expr, 1) = ")" Then
Dim As String inner = Mid(expr, 7, Len(expr) - 7)
Dim As Integer val = EvalExpr(inner)
Print val
Return val
End If
' Handle Custom Function Calls
Dim As Integer openParen = InStr(expr, "(")
If openParen > 1 And Right(expr, 1) = ")" Then
Dim As String fName = Trim(Left(expr, openParen - 1))
' Ignore standard operators treated as functions
If fName <> "+" And fName <> "-" And fName <> "*" And fName <> "/" Then
Dim As String argsStr = Mid(expr, openParen + 1, Len(expr) - openParen - 1)
Dim As String rawArgs(MAX_ARGS)
Dim As Integer aCount = 0
SplitArgs(argsStr, rawArgs(), aCount)
Dim As Integer evaledArgs(MAX_ARGS)
For i As Integer = 0 To aCount - 1
evaledArgs(i) = EvalExpr(rawArgs(i))
Next
Return ExecuteFunc(fName, evaledArgs(), aCount)
End If
End If
' Handle Inline Mathematical Operations (+, -, *, /)
Dim As Integer depth = 0
For i As Integer = Len(expr) To 1 Step -1
Dim As String c = Mid(expr, i, 1)
If c = ")" Then depth += 1
If c = "(" Then depth -= 1
If depth = 0 Then
If c = "+" Then Return EvalExpr(Left(expr, i - 1)) + EvalExpr(Mid(expr, i + 1))
If c = "-" Then Return EvalExpr(Left(expr, i - 1)) - EvalExpr(Mid(expr, i + 1))
End If
Next
depth = 0
For i As Integer = Len(expr) To 1 Step -1
Dim As String c = Mid(expr, i, 1)
If c = ")" Then depth += 1
If c = "(" Then depth -= 1
If depth = 0 Then
If c = "*" Then Return EvalExpr(Left(expr, i - 1)) * EvalExpr(Mid(expr, i + 1))
If c = "/" Then Return EvalExpr(Left(expr, i - 1)) / EvalExpr(Mid(expr, i + 1))
End If
Next
' Strip outer parenthesis if it's a grouped expression
If Left(expr, 1) = "(" And Right(expr, 1) = ")" Then
Return EvalExpr(Mid(expr, 2, Len(expr) - 2))
End If
' Base case: convert literal number string to integer
Return ValInt(expr)
End Function
' --- Execute Function Scope ---
Function ExecuteFunc(funcName As String, passedArgs() As Integer, argCount As Integer) As Integer
Dim As Integer fIdx = -1
For i As Integer = 0 To funcCount - 1
If functions(i).name = funcName Then
fIdx = i
Exit For
End If
Next
If fIdx = -1 Then
Print "Runtime Error: Function '" & funcName & "' not found!"
End 1
End If
Dim As String localBody = functions(fIdx).body
' Textually substitute parameters with argument values
For i As Integer = 0 To functions(fIdx).argCount - 1
localBody = ReplaceString(localBody, functions(fIdx).args(i), Str(passedArgs(i)))
Next
Return EvalExpr(localBody)
End Function
' =============================================================================
' --- MAIN RUNTIME MAIN EXECUTIVE ---
' =============================================================================
' Define our FUNCTOR source code explicitly
Dim As String sourceCode = _
"func double(x) { x * 2 } " & _
"func add_five(num) { num + 5 } " & _
"func main() { print(add_five(double(10))) }"
' Parse source blocks
ParseCode(sourceCode)
' Trigger implementation starting at main()
Dim As Integer dummyArgs(0)
ExecuteFunc("main", dummyArgs(), 0)
Print "Press any key to exit..."
Sleep
Editor is loading...
Leave a Comment