Class example with do.. loop

[Frank Brübach]

Hello.. found this old class example and wanted to Run but I have Got Error about do Loop structure

Code Select Expand

' 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


[Charles Pegge]

Hi Frank, I've marked altered lines '** to get it working

Code Select Expand

' 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


[Frank Brübach]

Many thanks Charles Runs perfect Here..

Another Last question how to fix this old example with an Evaluation function

Code Select Expand

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

[Charles Pegge]

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.

Code Select Expand

  '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


[Frank Brübach]

Thank you Charles thats a good example to study...

I have found another for me better evaluator with a source String

Code Select Expand

' 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