Hello.. found this old class example and wanted to Run but I have Got Error about do Loop structure
' lexObj.o2bas file
'
uses console
' do loop go below
'
'sys a=4
'
'sys b=0
' do
' b+=1
' if b>a then exit do
' end do 'or enddo
' b=0
' do
' b+=1
' if b>a then exit do
' loop
'print "ok"
'
' old example ok
'
==================
class ScriptObject
==================
string ss 'script text
sys j 'char index in text
sys b 'index for start of word
sys e 'index for end of word
sys lenw 'length of
byte* bb 'byte array overlay for text
byte ascw 'asci code for start of word
byte ascn 'asci code for next word / end-of-line
byte u1
byte isa 'is alpha
byte isn 'is number
byte isq 'is quoted string
byte ise 'is end of line
byte clc 'contains lowercase
method set(string s)
====================
ss=s
@bb=strptr ss
j=1
end method
'--------------------- problem zone ----- //
' end if expected, error
'
method SkipQuote()
==================
byte q=bb[j]
byte c
j++
do
c=bb[j]
if c=q : j++ : then exit do
if c=0 : then exit do
j++
end do
' loop end
'end if
'end if
end method
'--------------------- problem zone ----- //
method SkipSpace()
==================
do
select bb[j]
case 0 : exit do
case 33 to 255 : exit do
end select
j++
end do
ascn=bb[j]
end method
method SkipLSpace()
===================
do
select bb[j]
case 0 : exit do
case 10 : exit do
case 13 : exit do
case 33 to 255 : exit do
end select
j++
end do
ascn=bb[j]
end method
method NextWord()
=================
clc=0
cast dword *(@isa)=0 'clear isa/isn/isq/ise bytes
SkipSpace
ascw=ascn
b=j
do
select bb[j]
case 0 to 32 : exit do
case "a" to "z" : clc=1
case 34 : skipquote : exit do
case 96 : skipquote : exit do
end select
j++
end do
e=j
lenw=e-b
Skipspace
if lenw then return -1
end method
method getword() as string
==========================
return mid ss,b,lenw
end method
method WordStatus()
===================
sys chk
sys n=b
select ascw
case 13 : ise=1
case 10 : ise=1
case 0 : ise=3
case 34 : isq=1
case 96 : isq=3
case "-" : chk=45
case "." : chk=46
case "0" to "9" : isn=1
case "A" to "Z" : isa=1
case "a" to "z" : isa=3
end select
if chk=45
n++
select bb[n]
case "." : chk=46
case "0" to "9" : isn or=3
end select
end if
if chk=46
n++
select bb[n]
case "0" to "9" : isn or=5
end select
end if
if isa
if clc=0 : isa or=4 'uppercase alpha
end if
end if
end method
'
end class
'TEST
=====
sys e
sys printrpad(sys n,string s) {e=len s : print s : if e<n {print space n-e}}
ScriptObject s
's.set quote """ CAPITAL Upper miXed lower + ++ hyphen-one "two three" `four "five"` 1 2.5 -1.5 .5 -.5 """
s.set (quote """ CAPITAL Upper miXed lower + ++ hyphen-one "two three" `four "five"` 1 2.5 -1.5 .5 -.5 """)
do
if not s.nextword then exit do
s.WordStatus
color 11
printrpad 16, s.getword()
color 6
print "isa:" s.isa " isn:" s.isn " isq:" s.isq " ise:" s.ise
printl
end do
'loop end
color 5
print "ok"
waitkey
Hi Frank, I've marked altered lines '** to get it working
' lexObj.o2bas file
'
uses console
' do loop go below
'
'sys a=4
'
'sys b=0
' do
' b+=1
' if b>a then exit do
' end do 'or enddo
' b=0
' do
' b+=1
' if b>a then exit do
' loop
'print "ok"
'
' old example ok
'
==================
class ScriptObject
==================
string ss 'script text
sys j 'char index in text
sys b 'index for start of word
sys e 'index for end of word
sys lenw 'length of
byte* bb 'byte array overlay for text
byte ascw 'asci code for start of word
byte ascn 'asci code for next word / end-of-line
byte u1
byte isa 'is alpha
byte isn 'is number
byte isq 'is quoted string
byte ise 'is end of line
byte clc 'contains lowercase
method set(string s)
====================
ss=s
@bb=strptr ss
j=1
end method
'--------------------- problem zone ----- //
' end if expected, error
'
method SkipQuote()
==================
byte q=bb[j]
byte c
j++
do
c=bb[j]
if c=q then j++ : exit do '**
if c=0 then exit do '**
j++
end do
end method
'--------------------- problem zone ----- //
method SkipSpace()
==================
do
select bb[j]
case 0 : exit do
case 33 to 255 : exit do
end select
j++
end do
ascn=bb[j]
end method
method SkipLSpace()
===================
do
select bb[j]
case 0 : exit do
case 10 : exit do
case 13 : exit do
case 33 to 255 : exit do
end select
j++
end do
ascn=bb[j]
end method
method NextWord()
=================
clc=0
cast dword *(@isa)=0 'clear isa/isn/isq/ise bytes
SkipSpace
ascw=ascn
b=j
do
select bb[j]
case 0 to 32 : exit do
case "a" to "z" : clc=1
case 34 : skipquote : exit do
case 96 : skipquote : exit do
end select
j++
end do
e=j
lenw=e-b
Skipspace
if lenw then return -1
end method
method getword() as string
==========================
return mid ss,b,lenw
end method
method WordStatus()
===================
sys chk
sys n=b
select ascw
case 13 : ise=1
case 10 : ise=1
case 0 : ise=3
case 34 : isq=1
case 96 : isq=3
case "-" : chk=45
case "." : chk=46
case "0" to "9" : isn=1
case "A" to "Z" : isa=1
case "a" to "z" : isa=3
end select
if chk=45
n++
select bb[n]
case "." : chk=46
case "0" to "9" : isn or=3
end select
end if
if chk=46
n++
select bb[n]
case "0" to "9" : isn or=5
end select
end if
if isa
if clc=0 : isa or=4 'uppercase alpha
end if
end if
end method
'
end class
'TEST
=====
sys e
sys printrpad(sys n,string s) {e=len s : print s : if e<n {print space n-e}}
ScriptObject s
's.set quote """ CAPITAL Upper miXed lower + ++ hyphen-one "two three" `four "five"` 1 2.5 -1.5 .5 -.5 """
s.set (quote """ CAPITAL Upper miXed lower + ++ hyphen-one "two three" `four "five"` 1 2.5 -1.5 .5 -.5 """)
do
if not s.nextword then exit do
s.WordStatus
color 11
printrpad 16, s.getword()
color 6
print "isa:" s.isa " isn:" s.isn " isq:" s.isq " ise:" s.ise
printl
end do '**
color 14 '**
print "ok"
waitkey
Many thanks Charles Runs perfect Here..
Another Last question how to fix this old example with an Evaluation function
'-------------------------------------
'RUNTIME COMPILING FROM STRINGS
'WITH ACCESS TO ALL PARENTAL VARIABLES
'-------------------------------------
'
' I have added -----------
extern lib "oxygen.dll"
! o2_mode (sys m)
! o2_basic (string s)
! o2_exec (optional sys p) as sys
! o2_error () as string
! o2_errno () as sys
end extern
o2_mode 9
' I have added -----------
'--------------------------------------------------------------------------
function evaluate (s as string, byval b as long, byval e as long) as string
'==========================================================================
'
double x,y,z
long a,i,p=1
string v,u,tab,cr as string
'
cr=chr(13) chr(10) : tab=chr 9
v=nuls 4000
mid v,p,s+cr+cr
p+=4+len s
'
'a=compile s ' --> original code it's old one too
'
' my idea was
a=o2_basic s ' doesnt work however
'
sys er=error
if er then print `runtime error: ` er : exit function
for i=b to e
x=i
call a
u=str(x) tab str(y) cr
mid v,p,u : p+=len u
next
'
function=left v,p-1
end function
print evaluate `y=x*x*x`,1,10
print evaluate `y=sqrt x`,1,9
print "ok"
Thanks Frank
A type of dynamic compiler which can be used to evaluate. It goes through a complete compilation cycle every time you create a new set of functions, so it may not be efficient in all circumstances.
'DYNAMIC COMPILING A FUNCTION
'============================
'21:41 20/12/2024 CP
#compact
$ Filename "t.exe"
uses RTL64
'uses console
'extern lib "oxygen.dll" 'specify file path
extern lib "oxygen64.dll" 'specify file path
uses oxygenAPI
end extern
o2_mode 9
'DYNAMIC SOURCE
'==============
string s=quote """
sys ft[16]
print "helo "
function f() as string 'export
return str(pi())
end function
'
function finish() 'export
terminate
end function
'
ft={@f, @finish} 'mini function table
=@ft 'return the table pointer
"""
==============
o2_basic s 'compile source
if o2_errno
print o2_error
end
endif
sys tp 'function table pointer
tp=o2_exec(0) 'code to return the function table pointer
sys *tf 'table of functions
@tf=tp
'
'DECLARE
'=======
! *f() as string at tf[1]
! *fin() at tf[2]
'
'TEST
'====
print f() cr
fin() 'release program
'print "ok"
'wait
Thank you Charles thats a good example to study...
I have found another for me better evaluator with a source String
' SIMPLE EVALUATOR
'
' supporting:
' +-*/
' floating ppoint values
' variables a..z
' brackets
' multiple statements and lines
'
function evalnm(sys *dp, double *v,sys b)
=========================================
b-=48
if dp=0
v=v*10+b
else
dp*=10
v=v+b/dp
end if
end function
function evalop(sys op, double *a,v)
====================================
select op
case 0 : a=v
case "+" : a+=v
case "-" : a-=v
case "*" : a*=v
case "/" : a/=v
end select
end function
function eval(string s) as double
=================================
indexbase 0
byte b at (strptr s) 'source string
double a 'accum
double v 'value
double vv[256] 'variable store
double st[16] 'stack value
sys sp[16] 'stack operator
sys op 'operator
sys ai 'accum index
sys si 'stack index
sys vi 'variable index
sys dp 'decimal point
do
select b
case 0 : evalop(op,a,v) : return a
case 10 to 13 : evalop(op,a,v) : vv[ai]=a : a=0 : v=0 : op=0 : dp=0
case ":" : evalop(op,a,v) : vv[ai]=a : a=0 : v=0 : op=0 : dp=0
case "0" to "9" : evalnm(dp,v,b)
case "A" to "Z" : vi=b : v=vv(vi) : dp=0
case "a" to "z" : vi=b : v=vv(vi) : dp=0
case "=" : ai=vi
case "." : dp=1
case 42 to 47 : evalop(op,a,v) : op=b : v=0 : dp=0
case "(" : st[si]=a : sp[si]=op : a=0 : v=0 : op=0 : dp=0 : si++
case ")" : evalop(op,a,v) : si-- : v=a : a=st[si] : op=sp[si] : dp=0
end select
@b++
end do
end function
print eval("a=32 : b=16.25 : 2*(a+b) ") '96.5
print eval("a=12 : b=2.65 : 4*(a-b) ") ' 37,39999999999