Code: Select all
declare function eval(as integer)as string
type token
as string typ
as string value
end type
dim shared as token tk(),ast()
dim shared as integer tc,lb,erc
function isalp(c as string)as integer
return c >= "a" and c <= "z" or c >= "A" and c <= "Z"
end function
function isnum(c as string)as integer
return c >= "0" and c <= "9"
end function
function isalnum(c as string)as integer
return isalp(c) or isnum(c)
end function
function noparam()as double
return 1234
end function
function param(x as double,y as double)as double
return x * y
end function
function arg(id as string) as integer
select case id
case "abs","exp","log","sqr","fix",_
"frac","int","sgn","rnd" : return 1
case "param" : return 2
case "noparam" : return 0
end select
return -1
end function
sub add_token(t as string,v as string="")
redim preserve tk(ubound(tk)+1)
tk(ubound(tk)).typ = t
tk(ubound(tk)).value = v
end sub
sub add_ast(t as string,v as string="")
redim preserve ast(ubound(ast)+1)
ast(ubound(ast)).typ = t
ast(ubound(ast)).value = v
end sub
function lbp()as integer
select case tk(tc).value
case "<","<=",">",">=","<>","=" : return 20
case "+","-" : return 30
case "*","/" : return 40
case "^" : return 50
end select
return 0
end function
function factor() as string
dim lhs as string
select case tk(tc).typ
case "num" : return str(tc)
case "lpr"
tc += 1'
lhs = eval(0)
if tk(tc).typ <> "rpr" then return "end"
case "opr"
if tk(tc).value = "-" then
tk(tc).typ = "unr"
lhs = str(tc)
tc += 1'
return lhs + "," + factor
end if
case "idt"
lhs = str(tc)
tc += 1
if tk(tc).typ = "lpr" then
lhs += "," + str(tc)
tc += 1'
while tk(tc).typ <> "rpr"
lhs += "," + eval(0)
if tk(tc).typ <> "cma" then exit while
lhs += "," + str(tc)
tc += 1'
wend
if tk(tc).typ <> "rpr" then return "end"
lhs += "," + str(tc)
else : tc -= 1
end if
end select
return lhs
end function
function eval(rbp as integer)as string
dim lhs as string = factor
if tk(tc).typ = "end" or lhs = "end" then exit function
dim op as string
tc += 1
lb = lbp
while rbp < lbp
op = str(tc)
tc += 1
lhs = op + "," + lhs + "," + eval(lb)
wend
return lhs
end function
function evaluate()as double
dim as string op
dim as double v1,v2
select case ast(tc).typ
case "num" : return val(ast(tc).value)
case "unr" : tc += 1 : return -evaluate()
case "opr"
op = ast(tc).value
tc += 1 : v1 = evaluate()
tc += 1 : v2 = evaluate()
select case op
case "+" : return v1 + v2
case "-" : return v1 - v2
case "*" : return v1 * v2
case "/" : return v1 / v2
case "^" : return v1 ^ v2
case "<" : return v1 < v2
case "<=" : return v1 <= v2
case ">" : return v1 > v2
case ">=" : return v1 >= v2
case "<>" : return v1 <> v2
case "=" : return v1 = v2
end select
case "idt"
op = ast(tc).value
dim as integer t,a = arg(op)
if a = -1 then ?"Undefined : " + op : erc = 1 : exit function
dim as double v(a)
if ast(tc +1).typ = "lpr" then
tc += 2
while ast(tc).typ <> "rpr"
if t >= a then ?"Too many arg : " + op : erc = 1 : exit function
v(t) = evaluate()
tc += 1 : t += 1
if ast(tc).typ <> "cma" then exit while
tc += 1
wend
end if
if t < a then ?"Missing arg : " + op : erc =1 : exit function
'tc += 1
select case op
case "abs" : return abs(v(0))
case "exp" : return exp(v(0))
case "log" : return log(v(0))
case "sqr" : return sqr(v(0))
case "fix" : return fix(v(0))
case "frac" : return frac(v(0))
case "int" : return int(v(0))
case "sgn" : return sgn(v(0))
case "rnd" : return rnd(v(0))
case "param" : return param(v(0) , v(1))
case "noparam" : return noparam()
end select
end select
end function
sub add_exp(s as string)
dim as integer i
dim as string tmp
s += ","
while i < len(s)
tmp += chr(s[i])
if chr(s[i]) = "," then
add_ast(tk(val(tmp)).typ,tk(val(tmp)).value)
tmp = ""
end if
i += 1
wend
add_ast("end")
end sub
sub parse(src as string = "")
?
if src = "" then ?"No Input" : exit sub
?"Input : " + src
dim as integer dot
dim as string tmp,t
erase tk,ast
tc = 0
while tc < len(src)
if isalp(chr(src[tc])) then
while isalnum(chr(src[tc]))
tmp += chr(src[tc])
tc += 1
wend
add_token("idt",tmp)
tmp = ""
elseif isnum(chr(src[tc])) or src[tc] = 46 then
while isnum(chr(src[tc])) or src[tc] = 46
if src[tc] = 46 then dot += 1
tmp += chr(src[tc])
tc += 1
wend
if tmp = "." or dot > 1 then
?"Invalid number" : exit sub
else
add_token("num",str(val(tmp)))
tmp = "" : dot = 0
end if
else
t = chr(src[tc])
select case t'chr(src[i])
case "=","+","-","/","*","^" : add_token("opr",t)
case "<"
if chr(src[tc + 1]) = ">" or chr(src[tc + 1]) = "=" then
add_token("opr",t + chr(src[tc + 1]))
tc += 1
else
add_token("opr",t)
end if
case ">"
if chr(src[tc + 1]) = "=" then
add_token("opr",t + chr(src[tc + 1]))
tc += 1
else
add_token("opr",t)
end if
case "(" : add_token("lpr",t)
case ")" : add_token("rpr",t)
case "," : add_token("cma",t)
case " "
case else : ?"Unsupported symbol : " + t : exit sub
end select
tc += 1
end if
wend
add_token("end")
'for i as integer = lbound(tk) to ubound(tk)
' ?tk(i).typ + " : " + tk(i).value
'next
tc = 0
tmp = eval(0)
if tk(tc).typ <> "end" or tmp = "" or right(tmp,1) = "," then
?"syntax error : " & tc + 1
exit sub
end if
add_exp(tmp)
tmp = ""
for i as integer = lbound(ast) to ubound(ast)-1
tmp += ast(i).typ + "(" + ast(i).value + ")"
if i < ubound(ast)-1 then tmp += ","
next
?"Ast : " + tmp
tc = 0
dim as double res = evaluate()
if erc = 0 then ?"Output : " & res
erc = 0
''''''''''''''''''''''''''''''''''
end sub
parse("1+2*3")
parse("-1+2*3")
parse("-(1+2)*3")
parse("1+2*-(-3+4)/5")
parse(" 13 * (2 + -4) ^ 4 ")
parse(" 13 * (2 + -4) / ^ 4 ")
parse("-(abs(.5) + noparam)")
parse("(abs() + noparam)")
parse(".")
parse("()")
parse("")
sleep
Code: Select all
Input : 1+2*3
Ast : opr(+),num(1),opr(*),num(2),num(3)
Output : 7
Input : -1+2*3
Ast : opr(+),unr(-),num(1),opr(*),num(2),num(3)
Output : 5
Input : -(1+2)*3
Ast : opr(*),unr(-),opr(+),num(1),num(2),num(3)
Output : -9
Input : 1+2*-(-3+4)/5
Ast : opr(+),num(1),opr(/),opr(*),num(2),unr(-),opr(+),unr(-),num(3),num(4),num(
5)
Output : 0.6
Input : 13 * (2 + -4) ^ 4
Ast : opr(*),num(13),opr(^),opr(+),num(2),unr(-),num(4),num(4)
Output : 208
Input : 13 * (2 + -4) / ^ 4
syntax error : 11
Input : -(abs(.5) + noparam)
Ast : unr(-),opr(+),idt(abs),lpr((),num(0.5),rpr()),idt(noparam)
Output : -1234.5
Input : (abs() + noparam)
Ast : opr(+),idt(abs),lpr((),rpr()),idt(noparam)
Missing arg : abs
Input : .
Invalid number
Input : ()
syntax error : 3
No Input