Aurel tells All: Interpreters
most of things you can find on
 http://basicpro.mipropia.com/smf/index.php

where you member ..right?

aurelsoft.ucoz is for archive
I think that mark bPlus have account there
Reply
Hey Erik
Do you can recogize what is this few functions written in Java?
be careful it is not trick question. Big Grin
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;
    }
Reply
Yes, it looks like the core expression parser to a larger project, for example, does:

Code:
case (int)'(':

   value = getLogicalExpression();
   getRightParen();
   break;

parsing left parenthesis call itself?
dndbbs project:

Links to my MUD: (strictly 16-bit); AKA XP:

Dndbbs executables
http://www.filegate.net/pdn/pdnbasic/dnd50a1e.zip

Dndbbs source
http://www.filegate.net/pdn/pdnbasic/dnd50a1s.zip

Dndbbs upgrade
http://www.filegate.net/pdn/pdnbasic/dnd50a1u.zip

DNDDOOR - https://bit.ly/EriksDNDDoor DUNGEON - https://bit.ly/EriksDungeon
Interpreter - https://bit.ly/EriksSICK Hex Editor - https://bit.ly/EriksHexEditor Utilities - https://bit.ly/EriksUtils
QB45 files: - https://bit.ly/EriksQB45 QB64shell - https://bit.ly/QB64shell Some old QB64 versions: - https://bit.ly/OldQB64
Reply
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
Reply
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


Attached Files Thumbnail(s)

Reply
I have problems with SYMBOL chars ..so i use fancy
byte t at strptr(token) selection
and now seems to me that all tokens are presented properly.

Code:
$ Filename "ANIscript.exe" ' o2
include "RTL32.inc"
include "awinh.inc"
#lookahead
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)
'------------------------------------------------------------------------

INT win,wx=100,wy=0,ww=840,wh=640,wstyle = WS_MINMAXSIZE
INT bt0,b0ID=100,bt1,b1ID=101,bt2,b2ID=102 'buttons
INT static1,stID1=10,static2,staticID2=11,static3,staticID3=12,static4,staticID4=13,static5,staticID5=14  'staticTX
INT edit1,ed1ID=200,riched,richID=400,LBoxH,LBid=500,edit2,editID2=50
INT edit3,editID3=51,edit4,editID4=52,edit5,editID5=53,edit6,editID6=54
INT ipos ' LB item pos
STRING  outBuff="processing..." + crlf
STRING source[1000] ' source lines array
string pt = Space (255)
'bitmap image handlers -------------------------------------------------
INT bb0,bb1,bb2
'create main window ||||||||||||||||||||||||||||||||||||||||||||||||||||
win=SetWindow("ANI::v2",wx,wy,ww,wh,0,wstyle)
    InitDrawing(win)
    WindowColor( win, 220, 230, 250)
InvalidateRect(win, 0, 0)
'crete buttons||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
bt0 = SetButton(win,4,60,34,34,"New", 1409384576,0x200,b0ID)  'as image button flat 1409384576 - 1409351808
bb0 = LoadImage(0,"bScan.bmp",0,32,32,16):SendMessage(bt0, 247, 0, bb0) 'add bitmap to button
bt1 = SetButton(win,4,98,34,34,"Open", 1409384576,0x200,b1ID)
bb1 = LoadImage(0,"bOpen.bmp",0,32,32,16):SendMessage(bt1, 247, 0, bb1)
bt2 = SetButton(win,4,140,34,34,"Save", 1409384576,0x200,b2ID)
bb2 = LoadImage(0,"bProc.bmp",0,32,32,16):SendMessage(bt2, 247, 0, bb2)

'create EDIT1 - multiline --------------------------------------------
edit1 = SetEditBox(win,44,480,500,80, outBuff,  WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL,0x200,ed1ID) '50B01004 processing box
'create static control
static1 = SetStatic(win,6,8,54,16,"LINES",0,0,stID1) 'static 'LINES'
static2 = SetStatic(win,6,35,54,16,"LINE >>",0,0,staticID2) 'static 'LINES'
edit2 = SetEditBox(win,50,5,70,20,"num of Lines",0x50800000,0x200,editID2) 'edit for number of lines
edit3 = SetEditBox(win,50,32,710,22,"current Line",0x50800000,0x200,editID2) 'edit for current line
ControlFont(edit3, 15, 8, 400, "Courier New"): SetFocus edit3
static3 = SetStatic(win,120,8,54,16,"T-LINE",0,0,staticID3) 'static 'LINES'
edit4 = SetEditBox(win,160,6,60,20,"Line Num",0x50800000,0x200,editID4)

static4 = SetStatic(win,230,8,54,16,"T-CHAR",0,0,staticID4) 'static 'temp char
edit5 = SetEditBox(win,280,6,60,20,"CHAR",0x50800000,0x200,editID5) ' show char
ControlFont(edit5, 17, 9, 600, "Courier New")

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

'create RICHEDIT1 ##########################################################################################
'INT reStyle = WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_SUNKEN
'INT reStyle = 0x508010C4 /:rc code line::
riched= SetRichEdit (win, 44,60,500,400,"a = a+b", WS_CHILD|WS_VISIBLE|ES_MULTILINE|ES_WANTRETURN|WS_VSCROLL|WS_HSCROLL|ES_AUTOVSCROLL|ES_AUTOHSCROLL|ES_NOHIDESEL,0x200,richID)
ControlFont(riched, 15, 8, 400, "Courier New") : SetRichEditBackColor riched, RGB(250,244,179)
SetEditSelection( riched, -1,-1):InvalidateRect( riched, 0, 0)

'create listbox for token list ##########################################################################
LBoxH = SetListBox(win,560,60,200,400,"",0x50000140|CTLISTNOTIFY|WS_VSCROLL,0x200,LBid)
ControlFont(LBoxH, 17,7, 100, "Courier New")
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-1"
'SendMessage LboxH, LB_ADDSTRING, 0, "TOKEN-2"

'----------------------------------------------------------------------
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_PAINT
            BitBlt(hDC, 0, 0, ww, hh, hdcMem, 0, 0, SRCCOPY)
            InvalidateRect(win, 0, 0)
                
            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

if you interested how this post look on my euradioboad forum (myBB)
look here:
http://euradioboard.createmybb3.com/thre...html#pid36


Attached Files Thumbnail(s)

Reply
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
Reply
I forget..
Maybe someone want to try compiled exe if is not familiar with
Oxygen Basic ...i can put link for download?
Reply
just small additions..

ps .look the difference in posted images on my myBB
http://euradioboard.createmybb3.com/thre...html#pid37


Attached Files Thumbnail(s)

Reply
Just to let you know...
oh gee where I stoped ?

hmmm yes here... excuse me people... Smile


Code:
'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"


Attached Files Thumbnail(s)

Reply
What you think about this schematic of evaluation.


Attached Files Thumbnail(s)

Reply
For clarity....


Attached Files Thumbnail(s)

Reply
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

                case else
                    return value
            end select
            }
End Function

'*********************************************************
' Factor - Handles numbers,minus signs and parens
' <FACTOR> = <EXPRESSION> | <VARIABLE> | <CONSTANT>
'*********************************************************

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
'*******************************************************
Reply