Code:
'micro(A) Interpreter - with recursive descent token evaluator
' by Aurel - 26.3.2019 - last test 30.1.2020
include "awinh037.inc" ' awinh GUI api function
include "microAT.inc" ' tokenizer include
#lookahead
int tc=0 , ierror=0 ' token count, interpreting error
string token : int tkTyp ' define token as STRING : tkType as INT
'*********************************************************************
'globals
INT win,x=0,y=0,w=400,h=300,wstyle = WS_MINMAXSIZE
INT button0,b0ID=100
NumberFormat 6,1,0,0,0,0
'Interpreter Globals .........................................................................
string kwList[32] 'keyword list
kwList[1] = "VARNUM" : kwList[2] = "VARSTR" : kwList[3] = "VARPTR" : kwList[4] = "IF" : kwList[5] = "ELSE" : kwList[6] = "ENDIF"
kwList[7] = "WHILE" : kwList[8] = "WEND" : kwList[9] = "FOR" : kwList[10] = "TO" : kwList[11] = "STEP" : kwList[12] = "NEXT"
kwList[13]="PRINT" : kwList[14]="STR" : kwList[15]="VAL"
'..............................................................................................
int tkSTRING = 32, tkFLOAT = 33 , tkPOINTER = 34 , tkIF = 35 , tkELSE = 36, tkENDIF = 37
int tkWHILE = 38, tkWEND = 39 , tkFOR = 40 , tkTO = 41 , tkSTEP = 42 , tkNEXT = 43
int tkPRINT = 44 , tkSTR = 45, tkVAL = 46
'Global Variable,ID etc array ................................................................
int varID = 0
int varList[1024] : int varType[1024] :string varName[1024]: string varStr[1024] : float varNum[1024] : int varPtr[1024]
int ifCounter=0, elseCounter=0, endifCounter=0, whileCounter=0,wendCounter=0 ,forCounter=0,nextCounter=0
' Open Window with message loop...
win = SetWindow("micro(A):",x,y,w,h,0,wstyle)'
'button0 = SetButton(win,180,4,80,26,"Close (X)",0x50001000,0x200,b0ID)
'*********************************************************************
'test 1 - load source code into (microAT.inc) Tokenizer
string code = "varNum a: a=3 " + crlf 'enter your expression / crlf=EOL
codeLen=len(code)
tn = run_tokenizer(code)
MsgBox str(tn) ,"Tokenizer Out" ' 1 means OK!
'---------------------------------------------------------------
' prescan for variables,commands....
'---------------------------------------------------------------
'if tokenization error=0 then OK!..preScan()
int ps
If tokerr = 0 and tn = 1
ps = preScan()
Else
MsgBox "END" ,"Program Exit!"
End if
'if ps = 1 then OK...........................
if ps = 1
MsgBox "PreScan:OK!" ,"Continue..."
tokInterpreter() ' run token-interpreter
Else
MsgBox "END" ,"Program Exit!"
End if
'================================================================
Wait() '/// message loop ///
'===========================================================================================
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg
CASE WM_CLOSE
CloseWindow(win)
EndProgram
End Select
END SELECT
RETURN Default
END FUNCTION
'===========================================================================================
Sub preScan() as int
'MsgBox "OK..." ,"Pre:SCAN"
int i , numOfTokens = nTokens ,lineNum=0 ,varID=0, vID, n ,vTyp ' numofTokens as local/reset global nTokens
string vName
For i = 1 to numOfTokens
IF typList[i]=tkEOL: tokList[i]="EOL": lineNum++ : END IF 'check EndOfLine
IF typList[i] = tkIDENT
If ucase(tokList[i]) = kwList[1]: typList[i] = tkFLOAT 'if varNUM ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARNUM! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store num variable -low case var name-
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID : varName[varID] = lcase(tokList[i]) : varType[varID] = tkFLOAT :varNum[varID] = 0
MsgBox "Variable name: " + tokList[i] + " VAR.TYPE: " + str(varType[varID]) , "TYPE"
End if
i++
Wend
end if
End if ' endOf varNUM..........................................................................
If ucase(tokList[i]) = kwList[2]: typList[i] = tkSTRING 'if varSTR ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARSTR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store str variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkSTRING: varStr[varID] = ""
MsgBox "Variable name: " + tokList[i] ,"variable->STR"
End if
i++
Wend
end if
End if ' endOf varSTR.......................................
If ucase(tokList[i]) = kwList[3]: typList[i] = tkPOINTER 'if varPTR ...........................
if typList[i+1] <> tkIDENT 'check err
MsgBox "Missing variable after VARPTR! line: " + str(lineNum),"ERROR": return 0
else
i=i+1 ' next token
While typList[i] <> tkCOLON And typList[i] <> tkEOL 'store ptr variable
If typList[i] = tkIDENT : varID = varID + 1 : varList[i] = varID :: varName[varID] = lcase(tokList[i]): varType[varID] = tkPOINTER: varPtr[varID] = 0
MsgBox "Variable name: " + tokList[i] ,"variable->PTR"
End if
i++
Wend
end if
End if ' endOf varPTR.......................................
If ucase(tokList[i]) = kwList[4] : typList[i] = tkIF : ifCounter++ : End If 'if token 'IF
If ucase(tokList[i]) = kwList[5] : typList[i] = tkELSE : elseCounter++ : End If 'if token 'ELSE
If ucase(tokList[i]) = kwList[6] : typList[i] = tkENDIF : endifCounter++ : End If 'if token 'ENDIF'
If ucase(tokList[i]) = kwList[7] : typList[i] = tkWHILE : whileCounter++ : End If 'if token 'WHILE
If ucase(tokList[i]) = kwList[8] : typList[i] = tkWEND : wendCounter++ : End If 'if token 'WEND
If ucase(tokList[i]) = kwList[9] : typList[i] = tkFOR : forCounter++ : End If 'if token 'FOR
If ucase(tokList[i]) = kwList[10] : typList[i] = tkTO : End If 'if token 'TO
If ucase(tokList[i]) = kwList[11] : typList[i] = tkSTEP : End If 'if token 'STEP
If ucase(tokList[i]) = kwList[12] : typList[i] = tkNEXT : nextCounter++ : End If 'if token 'NEXT
If ucase(tokList[i]) = kwList[13] : typList[i] = tkPRINT : End If 'if token 'PRINT
ELSE
'error
END IF
' if is variable outside declaration varNUM,varSTR,varPTR...
' search for varible name and return variable ID
IF typList[i] = tkIDENT
vName = tokList[i] : print "Variable_Name: " + vName : vID=0
'loop to find var name,id,typ
For n = 1 to varID
if vName = lcase(varName[n]) : print "match_name"
vID = n 'id is n
vTyp = varType[vID] : print "vtyp: " + str(vTyp)
varList[i] = vID ' set var list with id from varName array-> tokList[i],typList[i],varList[i]=id
end if
Next n
if vID = 0 : print "error-varID not found!": return 0: end if
END IF
Next i
return 1
End sub
'=================================================================================================================
Sub tokInterpreter()
int tok=0,ntok=0,vID=0 ,vTyp=0
tc=0
While tc < nTokens
start:
gettok() : print "TOKEN:" + tokList[tc]
tok = tkTyp : ntok = typList[tc+1]
IF tok = tkFLOAT ' token is varNUM
tc++
While typList[tc] <> tkCOLON And typList[tc] <> tkEOL 'skip tokens to colon/eol
tc++
Wend
print "TC-test" + str(tc)
'goto start
END IF
IF tok = tkIDENT
print "IDENT-TOKEN:" + tokList[tc]
print "tok:" + str(tok)
print "varType:" + str(varType[tc])
vID = varList[tc] 'get ID
vTyp = varType[vID]
' vID = varList[tc] : vTyp = varType[vID] : print "varID: " + str(vID) + ":VarType:: " + str(vTyp)
If vTyp = tkFLOAT ' numeric var
if ntok = tkEQUAL
tc++ : print "TC:" + str(tc) ' skip "=" is assign
exec_expr()
end if
End if
END IF
Wend
End Sub
'=================================================================================================================
'-----------------------------------------------------
sub gettok()
tc++
token = tokList[tc] : tkTyp = typList[tc]
'test
if tokList[tc+1] <> "" then return
end sub
'----------------------------------------------------
sub expr() as float
float v
If token = "-"
v = -(term())
else
v = term()
end if
while token = "+" or token = "-"
if token = "+": gettok() : v = v + term(): end if
if token = "-": gettok() : v = v - term(): end if
wend
return v
end sub
'---------------------------------------------------
sub term() as float
float v
v = factor()
while token = "*" or token = "/"
if token = "*": gettok() : v = v * factor(): end if
if token = "/": gettok() : v = v / factor(): end if
wend
return v
end sub
'-------------------------------------------------------
sub factor() as float
float v
if asc(token)>47 and asc(token)<58 'nums
v = val(token)
gettok()
end if
if asc(token)=40 and asc(token)<>41 'match (...)
gettok() : v = expr() : gettok()
end if
return v
end sub
'execute-----------------------------------------------------
sub exec_expr
gettok()'start
float res = expr()
MsgBox "RESULT=" + str(res) , "EXEC_EXPR:"
end sub