You are not logged in or registered. Please login or register to use the full functionality of this board...
SIGN IN Join Our Community For FREE


SIMPLE EVALUATOR
05-07-2017, 10:36 AM
Post: #1
 (Print Post)
SIMPLE EVALUATOR
This one is created by Charles Pegge ,author of o2
is simple but powerful Wink
Code Snippet: [Select]
'SIMPLE EVALUATOR
'by Charles Pegge
' supporting:
' +-*/
' floating ppoint values
' variables a..z
' brackets
' multiple statements and lines

indexbase 0

% maxvar 1024

string vn[maxvar] ' variable name
double vv[maxvar] ' variable store
double st[16]     ' stack value
sys    sp[16]     ' stack operator

sys    vnb=1      ' base of var lists
sys    vne=1      ' end of var lists


function wordbound(byte*b) as sys
=================================
do
  select b
  case "0" to "9"
  case "A" to "Z"
  case "a" to "z"
  case else : exit do
  end select
  @b++
end do
return @b
end function


function newvar(string wr,double v) as sys
==========================================
vn[vne]=wr 'new variable name
vv[vne]=0  'value
vne++
if vne>maxvar then vne=maxvar 'clamp
return vne-1
end function


function lookup(string wr) as sys
=================================
sys i=vnb,f=0
do
  if i>=vne then exit do 'end of var list
  if wr=vn[i] then f=i : exit do
  i++
end do
return f
end function


function lookupv(sys p) as sys
==============================
byte b at (*p)
byte e at (wordbound b)
sys lw=@e-@b
if lw=0 then return 0 'empty word
*p=@e-1 'update source position
string wr=nuls lw
copy strptr(wr),@b,lw
sys f=lookup(wr)
if not f then f=newvar(wr,0)
return f
end function


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
'case
end select
end function


function eval(string s) as double
=================================
byte b at (strptr s) 'source string
double a       'accum
double v       'value
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=lookupv(@@b) : v=vv(vi) : dp=0
  case "a" to "z" : vi=lookupv(@@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("av= -0.15*5 ") '96.5
'print eval("av=32 : bv=16.25 : 2*(av+bv) ")
'print eval("av=32 : bv=16.25 : 2*(av+bv) ")
'print eval("av=32 : bv=16.25 : 2*(av+bv) ")



basicPro forum:
http://basicpro.mipropia.com/smf/index.php
EU Radioboard forum:
http://euradioboard.createmybb3.com/index.php
AurelSoft main site:
http://aurelsoft.ucoz.com
Find all posts by this user
Like Post
The following 1 user Likes Aurel's post:
bplus
05-07-2017, 10:44 AM
Post: #2
 (Print Post)
RE: SIMPLE EVALUATOR
Now this looks very interesting to me because it does not have too many lines!


I have heard Charles Pegge is a genius (from his admirers).
Find all posts by this user
Like Post
05-07-2017, 11:20 AM (This post was last modified: 05-07-2017 11:27 AM by bplus.)
Post: #3
 (Print Post)
RE: SIMPLE EVALUATOR
Here is my simple evaluator (this was part of my SmallBASIC desktop setup I zip packaged for you all):
Code Snippet: [Select]
'eval calculator.bas  SmallBASIC 0.12.2 [B+=MGA] 2016-04-12
'just CHAIN, this version show many improtant lessons keep on desktop
'Thanks shian!

repeat
  input "enter string to evaluate ";es
  if es <> "" then ? eval(es)
until es = ""
func eval(s)
  'shian first showed this sort of enclosure of quotes with escape codes
  'chain "a="+s+":env (\"eval=\"+str(a))"
  
  'shian has this in Language reference,
  'oh it doesn't even fool with intermediate variable like my a
  Chain "env " + enclose("EVAL=") + " + Str(" + s + ")"
  eval = env("eval")
end

I like showing these code snippets better than attachment zippos.

The function eval has 2 lines in it!

Of course a real and true BASIC would have EVAL built-in (IMHO).

Does anyone think, like me, that might replace the VAL function?
I throw that idea out to future BASIC developers, no charge. ;-))

PS I am liking this post more and more, it is not often I get to engage in Aurel things.
He is so often engaged with his interpreter projects and posting of them or his editors.
Find all posts by this user
Like Post



Forum Jump:


User(s) browsing this thread: 1 Guest(s)




QB64 Member Project - Foursight
QB64 Member Project - Dakapo
QB64 Member Project - ARB Checkers
QB64 Member Project - MAPTRIANGLE
QB64 Member Project - Score 4
QB64 Member Project - Color Rotating Text
QB64 Member Project - Martin Fractals version four
QB64 Member Project - Domain
QB64 Member Project - Inside Moves
QB64 Member Project - Touche
QB64 Member Project - Martin Fractals version two
QB64 Member Project - Kings Court
QB64 Member Project - Kings Valley verion one
QB64 Member Project - Martin Fractals version three
QB64 Member Project - Kings Vallery version two
QB64 Member Project - Amazon
QB64 Member Project - Dreamy Clock
QB64 Member Project - Algeria Weather
QB64 Member Project - Blokus
QB64 Member Project - Swirl
QB64 Member Project - Splatter
QB64 Member Project - Red Scrolling LED Sign
QB64 Member Project - Overboard
QB64 Member Project - Line Thickness
QB64 Member Project - Point Blank
QB64 Member Project - Pivet version one
QB64 Member Project - Pivot version two
QB64 Member Project - Input
QB64 Member Project - Qubic
QB64 Member Project - Isolation
QB64 Member Project - Martin Fractals version one
QB64 Member Project - Quarto
QB64 Member Project - 9 Board
QB64 Member Project - Sabotage
QB64 Member Project - RGB Color Wheel
QB64 Member Project - STxAxTIC 3D World
QB64 Member Project - Othello
QB64 Member Project - Full Color LED Sign
QB64 Member Project - Color Triangles
QB64 Member Project - OpenGL Triangles
QB64 Member Project - Exit
QB64 Member Project - Kobolts Monopoly
QB64 Member Project - Connect Four
QB64 Member Project - Spiro Roses
QB64 Member Project - Bowditch curve
QB64 Member Project - Basic Dithering
QB64 Member Project - Rubix's Magic
QB64 Member Project - Rotating Background
QB64 Member Project - Spinning Color Wheel