04-20-2018, 05:04 AM This post was last modified: 04-20-2018, 05:06 AM by Aurel. Edited 0 times
Hey Erik
Do you can recogize what is this few functions written in Java?
be careful it is not trick question.
and
It is part of interpreter evaluator
What you think about that?
Code:
final double getExpression() {
double value = getTerm();
int next;
while (true) {
next = nextToken();
if (next=='+') {
getToken();
value += getTerm();
} else if (next=='-') {
getToken();
value -= getTerm();
} else
break;
}
return value;
}
final double getTerm() {
double value = getFactor();
boolean done = false;
int next;
while (!done) {
next = nextToken();
switch (next) {
case '*': getToken(); value *= getFactor(); break;
case '/': getToken(); value /= getFactor(); break;
case '%': getToken(); value %= getFactor(); break;
case '&': getToken(); value = (int)value&(int)getFactor(); break;
case '|': getToken(); value = (int)value|(int)getFactor(); break;
case '^': getToken(); value = (int)value^(int)getFactor(); break;
case SHIFT_RIGHT: getToken(); value = (int)value>>(int)getFactor(); break;
case SHIFT_LEFT: getToken(); value = (int)value<<(int)getFactor(); break;
default: done = true; break;
}
}
return value;
}
final double getFactor() {
double value = 0.0;
Variable v = null;
getToken();
switch (token) {
case NUMBER:
value = tokenValue;
break;
case NUMERIC_FUNCTION:
value = func.getFunctionValue(pgm.table[tokenAddress].type);
break;
case STRING_FUNCTION:
String str = func.getStringFunction(pgm.table[tokenAddress].type);
value = Tools.parseDouble(str);
if ("NaN".equals(str))
value = Double.NaN;
else if (Double.isNaN(value))
error("Numeric value expected");
break;
case USER_FUNCTION:
v = runUserFunction();
if (v==null)
error("No return value");
if (done)
value = 0;
else {
if (v.getString()!=null)
error("Numeric return value expected");
else
value = v.getValue();
}
break;
case TRUE: value = 1.0; break;
case FALSE: value = 0.0; break;
case PI: value = Math.PI; break;
case NaN: value = Double.NaN; break;
case WORD:
v = lookupVariable();
if (v==null)
return 0.0;
int next = nextToken();
if (next=='[') {
v = getArrayElement(v);
value = v.getValue();
next = nextToken();
} else if (next=='.') {
value = getArrayLength(v);
next = nextToken();
} else {
if (prefixValue!=0 && !checkingType) {
v.setValue(v.getValue()+prefixValue);
prefixValue = 0;
}
value = v.getValue();
}
if (!(next==PLUS_PLUS || next==MINUS_MINUS))
break;
getToken();
if (token==PLUS_PLUS)
v.setValue(v.getValue()+(checkingType?0:1));
else
v.setValue(v.getValue()-(checkingType?0:1));
break;
case (int)'(':
value = getLogicalExpression();
getRightParen();
break;
case PLUS_PLUS:
prefixValue = 1;
value = getFactor();
break;
case MINUS_MINUS:
prefixValue = -1;
value = getFactor();
break;
case '!':
value = getFactor();
if (value==0.0 || value==1.0) {
value = value==0.0?1.0:0.0;
} else
error("Boolean expected");
break;
case '-':
value = -getFactor();
break;
case '~':
value = ~(int)getFactor();
break;
default:
error("Number or numeric function expected");
}
// IJ.log("getFactor: "+value+" "+pgm.decodeToken(preToken,0));
return value;
}
04-20-2018, 09:11 PM This post was last modified: 04-20-2018, 09:17 PM by Aurel. Edited 0 times
Quote:parsing left parenthesis call itself?
Yes ...you see that?
It looks that most of things in this (i think is written in Java) interpreter use recursion.
It is called ImageJ and i found it somewhere on net.
But another point is that this interpreter parse + evaluate tokens from
token list - token array and
should be easy to traslate to basic - dialect
Erik ( and others of course)
I think that Tokenizer part is finished.
last IFblock is commented because of newLine chr(10) is already used inside
CRLF with tokens buffer.
In interpreter this buffer should be array of tokens + array of token types
I think that you (or someone else interested) can translate this example in
your own favorite dialect.
in qb64 i don't think you have standard windows msgBox BUT
you probably can put the each token in token array then print
whole array on screen ..or similar.
Code:
'Tokenizer for basic -like syntax ...origin in python
'PyQB tokenizer translation to Oxygen Basic - by Aurel 2018
$ Filename "PyQB.exe" 'specific to o2 - compile to ...exe
include "RTL32.inc" 'specific to o2 - include runtime lib
#lookahead 'specific to o2 - auto declare for procedures
string KEYWORDS[] = {"CLS","PRINT","IF","ELSE","FOR","TO","NEXT","ENDIF","WHILE","WEND","UNTIL","DO","LOOP","THEN"}
string SYMBOLS = ":=()+-*/<>"
string ALPHABETS = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz$#"
string DQ = chr(34)
string NUMBERS = "0123456789"
string NUMBERS_WITH_DECIMALPOINT = NUMBERS + "."
string ALPHANUMBERS = ALPHABETS + NUMBERS
string ALPHANUMBERS_WITH_UNDERSCORE = ALPHANUMBERS + "_"
string tokens 'token buffer 'tokens[1024] ' token list
string crlf = chr(13)+chr(10)
function tokenizer(string code) as string
string token, ch
'
'load file?
'
INT i,j
'................................
'print str(len(code))
'.................................
i=1
WHILE i <= len(code)
IF instr(ALPHABETS, mid(code,i,1)) <> 0 'isAlpha
while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
token = token + mid(code, i, 1)
i=i+1
wend
' PRINT str i
'print token
if ucase(token)= isKeyword(token) ' search keyword list
tokens = tokens + token + " ~ KEYWORD" + crlf
token=""
else
tokens = tokens + token + " ~ IDENTIFIER" + crlf 'variabe
token=""
end if
'token=""
'i=i+1
END IF
IF i <= len(code) and instr(SYMBOLS, mid(code, i, 1)) > 0 'sym operators
token = mid(code, i, 1)
'print token
tokens = tokens + token + " ~ SYMBOL" + crlf
i=i+1
token=""
END IF
IF instr(NUMBERS, mid(code, i, 1)) <> 0 'numbers
while i <= len(code) and INSTR(NUMBERS_WITH_DECIMALPOINT,mid(code,i,1)) <> 0
token = token + mid(code,i,1)
i=i+1
wend
tokens = tokens + token + " ~ NUMBER" + crlf
token=""
END IF
'elseif ch = chr(34) 'quote "
IF INSTR(mid(code,i,1),DQ) <> 0
'token = ""
i = i + 1 ' skip first quote "......
while i<= len(code) and mid(code,i+1,1) <> chr(34) 'string literal inside quotes "......."
token = token + mid(code,i,1)
i=i+1
wend
tokens = tokens + token + " ~ STRING-LITERAL" + crlf
token=""
i=i+1 ' skip second quote ......"
END IF
IF i <= len(code) and mid(code, i, 1) = " " 'whitespace
'token=""
i=i+1 'skip whitespace
END IF
'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
'IF i <= len(code) and mid(code,i,1) = chr(10)
'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
'i=i+1
' END IF
'else
'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
'i=i+1
WEND
Return tokens
end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
if ucase(tok) = KEYWORDS[n] ' if is KEYWORD
RETURN KEYWORDS[n]
end if
next n
Return ""
end function
'.............................................................
'test tokenizer
string tokenList
string input = "For n= 10 To 100 :a= a*0.35 : Next n :prinT "+ chr(34) + "Ok" ' in real must be last quote"
'call tokenizer
tokenList = tokenizer(input)
print tokenList
static5 = SetStatic(win,350,8,54,16,"CHAR-POS",0,0,staticID5) 'static 'charPos
edit6 = SetEditBox(win,410,6,60,20,"POS",0x50800000,0x200,editID6) ' position in line
'----------------------------------------------------------------------
Wait() 'message loop
'----------------------------------------------------------------------
'func main
Function WndProc (sys hwnd,wmsg,wparam,lparam) as sys callback
SELECT hwnd
CASE win
Select wmsg
CASE WM_CREATE
'InitDrawing(win)
'WindowColor( win, 220, 230, 250)
CASE WM_CLOSE
CloseWindow(win)
EndProgram
ExitProcess 0
CASE WM_COMMAND
controlID = LoWord(wParam) 'get control ID
notifyCode = HiWord(wParam) 'get notification message
select controlID
case b1ID 'open file
if notifycode=0
doOpen()
end if
case b0ID 'scan >>>
if notifycode=0
doScan()
end if
end select
End Select
END SELECT
RETURN Default
END FUNCTION
'************************************************
'**** A N I -> P R O C E S S I N G ********
'************************************************
'open source file
Sub doOpen
string fName="", dir="", sep=chr(0) , title="Open File... "
filter = "All Files "+sep+"*.*"+sep+"Bscript files "+sep+"*.bas"
title="Open File... "
fName = FileDialog(dir,filter,title,0,0,"txt")
IF fName = "" 'almost useless ?
SendMessage edit1,WM_SETTEXT,0,strptr("NO FILE ! ") : Return
END IF
'SendMessage status,WM_SETTEXT,0,strptr(fName)
char tx[500000] : tx = GetFile fName 'load file into char buffer
'SendMessage riched, 12, 0, strptr(tx) 'show file in richedit
SetText (riched,tx)
string numOfLines : int LineCount : LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0
numOfLines = str(LineCount) : SetText (edit2,numOfLines) ' show result in edit2
outBuff = outBuff + "file_loaded..." + crlf : SetText (edit1,outBuff)
outBuff = outBuff + "number of lines : " + numOfLines + crlf : SetText (edit1,outBuff)
frees tx
End Sub
'scan source line -----------------------------------------------------------------------
Sub doScan
string s,sc,cLine, tbuff
string pt = Space (255) ' also you may try char pt[255]=""
int i ,LineCount=1 ,crPos, first
ipos=0 'reset item position
SetText(edit3,"") ' clear current line box
LineCount = SendMessage riched, EM_GETLINECOUNT, 0,0 ' get number of Lines
SetText (edit1,"WAIT..scanning >>>>") : MsgBox "SCAN FILE","OK!..START"
'scan each line
For i = 0 to LineCount-1
' enable events..so i use PeekMessage.....................
' while PeekMessage (&wm,0,0,0,Pm_Remove)>0 ' //peek
'TranslateMessage (&wm)
'DispatchMessage (&wm)
'wend
SendMessage (riched, EM_GETLINE, i, pt) ' get line from richedit control
'first = SendMessage riched, EM_LINEINDEX, i, 0
' MsgBox pt , "INFO"
if pt <> ""
s = Ltrim(pt) 'trim left side
crPos = instr(pt,chr(13)) : ' check CR position /msgbox "POS:"+str(crPos),"CHR(13).POS"
s = MID( pt, 1, crPos-1) ' extract string / text
else
s=""
end if
SetText edit4, str(i) 'show line number
SetText(edit3, s) 'show current line in single-Line edit box
cLine = GetText(edit3) 'get text from edit control
Tokenizer(cLine) 'tokenize line
'get char func >>>>>>>>>>>>>>>>>>
GetChar(cLine)
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Sendmessage riched,EM_HIDESEL,i,0
'SetEditSelection( riched, first,len pt)
'Sendmessage riched,EM_HIDESEL,i,0
s="" : 'sleep = 100 ' slow down..tweak for your computer-200
'SendMessage riched,EM_SCROLL ,1,0
Next i
SetText edit1,"FINISHED!"
End Sub
'-----------------------------------------------------------------------------------------
SUB GetChar(string sLine)
int pos=1,lineSize
string ch,nextCh,tLine
tLine = Mid(sLine,1,Len(sLine))
lineSize=LEN(tLine)
while pos <= lineSize
ch = Mid( tLine,pos,1)
' sleep 100 '200
SetText(edit5,ch) 'show character
SetText(edit6,str(pos)) 'show char position in line
ch=""
pos=pos+1
wend
End Sub
'-----------------------------------------------------------------------------------------
Function SetEditSelection(int eHandle, sStart, sEnd)
SendMessage( ehandle, EM_SETSEL, sstart, send)
End Function
function tokenizer(code as string)
'print "CODE:" + code
string token, ch
'load file?
'
INT i,j
'................................
'print "CODE-LEN:" + str(len(code))
'.................................
i=1
WHILE i <= len(code)
IF instr(ALPHABETS, mid(code,i,1)) <> 0 'isAlpha
while i <= len(code) and INSTR(ALPHABETS ,mid(code,i,1)) > 0
token = token + mid(code, i, 1)
i=i+1
wend
'PRINT "alpha:" str i
'print token
if ucase(token)= isKeyword(token) ' search keyword list
token = token + " ~ KEYWORD"
SendMessage LboxH, LB_ADDSTRING, 0, token
'ipos++
token=""
else
token = token + " ~ IDENTIFIER" 'variabe
SendMessage LboxH, LB_ADDSTRING, 0, token
'ipos++
token=""
end if
'token=""
'i=i+1
END IF
IF instr(SYMBOLS, mid(code, i, 1)) > 0 and i <= len(code)'sym operators
token = mid(code, i, 1)
'print token
byte t at strptr(token)
select t
case "+"
token = "+" + " ~PLUS"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "-"
token = "-" + " ~MINUS"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "*"
token = "*" + " ~MULTI"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "/"
token = "/" + " ~DIVIDE"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "^"
token = "^" + " ~POWER"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "("
token = "(" + " ~LPAREN"
SendMessage LboxH, LB_ADDSTRING, 0, token
case ")"
token = ")" + " ~RPAREN"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "["
token = "[" + " ~LBRACKET"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "]"
token = "]" + " ~RBRACKET"
SendMessage LboxH, LB_ADDSTRING, 0, token
case ","
token = "," + " ~COMMA"
SendMessage LboxH, LB_ADDSTRING, 0, token
case ":"
token = ":" + " ~COLON"
SendMessage LboxH, LB_ADDSTRING, 0, token
case "="
token = "=" + " ~EQUAL"
SendMessage LboxH, LB_ADDSTRING, 0, token
end select
i=i+1
token=""
END IF
IF instr(NUMBERS, mid(code, i, 1)) <> 0 and i <= len(code) 'numbers
while i <= len(code) and INSTR(NUMBERS,mid(code,i,1)) <> 0
token = token + mid(code,i,1)
i=i+1
wend
token = token + " ~ NUMBER" + crlf
SendMessage LboxH, LB_ADDSTRING, 0, token
' ipos++
token=""
END IF
'elseif ch = chr(34) 'quote "
IF INSTR(mid(code,i,1),DQ) <> 0
'token = ""
i = i + 1 ' skip first quote "......
while mid(code,i,1) <> chr(34) 'string literal inside quotes "......."
token = token + mid(code,i,1)
i=i+1
wend
'tokens = tokens + token '+ " ~ STRING-LITERAL" + crlf
SendMessage LboxH, LB_ADDSTRING, 0, token + " ~STRING"
token=""
i=i+2 ' skip second quote ......"
END IF
IF mid(code, i, 1) = " " 'whitespace
'print "WHITE:" + str(i)
i=i+1 'skip whitespace
END IF
'elseif ch = chr(10) ' not used because of CRLF in bufer -> tokens
'IF i <= len(code) and mid(code,i,1) = chr(10)
'tokens = tokens + mid(code,i,1) + " :NEWLINE" + crlf ' or end of instruction
'print "NEWLINE"
'return
'i=i+1
'END IF
'else
'tokens = tokens + ch + " :UNINDENTIFIED - ERROR!" + crlf
'i=i+1
'PRINT "BEFORE_WEND:" + str(i)
WEND
'Return token
' Return
end function
'...........................................................
function isKeyword(byval tok as string) as string
'string ret
for n = 1 to 14
if ucase(tok) = KEYWORDS[n] ' if is KEYWORD
RETURN KEYWORDS[n]
end if
next n
Return ""
end function
I am thinking ,,for such a simple presentation there is no need
to have full set of commands , just few for testing purpose
so i will remove 3 loops and left just FOR loop.
And for now i will give up from building AST.
Also for display i need WINDOW command ,PRINT is there
so maybe some primitive drawing commands like DOT,LINE etc
Of course i will add two list tokList, toktypList
'Parser -o2- by Aurel 2018
$ filename "ParseEval.exe"
#autodim off
'#lookahead
string op,token,crlf= chr(13)+chr(10)
bstring buff
'test expression -> 2+3*4
string TokenList[] = {"2","+","3","*","4"}
'TokenList[1]="2"
'TokenList[2]="+"
'TokenList[3]="3"
'TokenList[4]="*"
'TokenList[5]="4"
'string OperatorList[] = {"-","+","*","/","^","("} '6
'get size of list?
print spanof(TokenList) ' size of array -> 5 ...count of tokens
int tokCount = spanOf(TokenList)
int prec
string opStack
string opPLUS,opMULTI
string cell
'
'loop trough tokens
int t
For t = 1 to tokCount
token = TokenList[t]
If instr("+-*/^(",token) <> 0
op = token
print "OP:" + op
End if
if token <> op
buff = buff + tokenlist[t]
end if
byte op at strptr(token) 'must be before select
select op
case "("
buff = buff + tokenlist[t] + crlf
'......................................
case "^"
buff = buff + tokenlist[t] + crlf
'......................................
case "/"
buff = buff + tokenlist[t] + crlf
'.....................................
case "*"
buff = buff + tokenlist[t] + crlf
'......................................
case "+"
buff = buff + tokenlist[t] + crlf
'......................................
end select
'buff = buff + token
'print "BUFF: " buff + " N:" + str(t)
' i instr(token,"+-*/^(",op) = 0
'buff = buff + token + crlf
'end if
Next t
'show operator buffer
print buff
buff=NULL
print "OK"
Directly from 1993 - PC Magazine ,original written in C
not tested yet
Code:
'EVAL.C expression evaluator
$ filename "EVALC.exe"
include "rtl32.inc"
#lookahead
'******************************************
' EXPRESSION EVALUATOR - PC Magazine 1993
'******************************************
def false 0
def true 1
int NextChar
int contin = true
! Factor() as float
! Expression() as float
! Term() as float
'************************************************************
' GetNextChar - Reads chars until a non-space char is found
'************************************************************
Function GetNextChar()
{
while ((NextChar = getchar()) = " " )
}
End Function
'**************************************************************
' Expression - A Recursive routine that evaluates an expression
' EXPRESSION = <EXPRESSION> + TERM | <EXPRESSION> - <TERM>
'**************************************************************
Function Expression() as float
float value
value = Term()
for (; {
select NextChar
case " "
GetNextChar()
break
case "+"
GetNextChar()
value = value + Term()
continue
case "-"
GetNextChar()
value = value - Term()
continue
case else
return value
end select
}
'****************************************************************
' Term - Handles Multiplication and division
' <TERM> = <TERM> * <FACTOR> | <TERM> div <FACTOR> | <FACTOR>
'****************************************************************
Function Term() as float
float value, divisor
value = Factor()
for (; {
select NextChar
case " "
GetNextChar()
exit for
case "*"
GetNextChar()
value = value * Factor()
continue
case "^"
GetNextChar()
value = value - Factor()
continue
case "/"
GetNextChar()
if ((divisor = Factor()) <> 0
value = value / divisor
else
print " DIVISION BY ZERO !"
Exit Function
end if
continue
Function Factor() as float
float value = 0
int count = 0
int i
int d_point = false
if (( NextChar <= "9") AND (NextChar >= "0"))
while ((NextChar <= "9") AND (NextChar >= "0"))
value = value * 10 + NextChar - "0"
NextChar = getchar()
if (d_point)
count++
if (NextChar = ".")
NextChar = getchar()
d_point = true
end if
end if
wend
for i = 0 To (i < count)
value = value / 10
return value
next
else
select NextChar
case "-"
GetNextChar()
return -1 * Factor()
case "("
GetNextChar()
value = Expression()
if (NextChar <> ")"
print " MISMATCHED PARENTHES !"
Exit Function
else
NextChar = getchar()
return value
end if
case "."
d_point = true
case else
contin = false
end select
return 0
End Function
'*******************************************************
' Main - Program entry point
'*******************************************************
