Arithmetic evaluation: Difference between revisions

=={{header|FreeBASIC}}==

<lang FreeBASIC>

type Tree

as Tree ptr leftp, rightp

op as string

value as double

end type

dim shared as string sym, usr_input

dim shared tokenval as double

declare function expr(byval p as integer) as Tree ptr

function isdigit(byval ch as string) as long

return (ch <> "") and Asc(ch) >= Asc("0") and Asc(ch) <= Asc("9")

end function

sub error_msg(byval msg as string)

print msg

system

end sub

sub getsym()

do

if len(usr_input) = 0 then

line input usr_input

usr_input += chr(10)

endif

dim as string ch = mid(usr_input, 1, 1)

usr_input = mid(usr_input, 2)

select case ch

case " "

case chr(10), "": sym = "": return

case "+": sym = "+": return

case "-": sym = "-": return

case "*": sym = "*": return

case "/": sym = "/": return

case "(": sym = "(": return

case ")": sym = ")": return

case else

if isdigit(ch) then

dim s as string = ""

dim dot as integer = 0

do

s += ch

if ch = "." then dot += 1

ch = mid(usr_input, 1, 1)

usr_input = mid(usr_input, 2)

loop until not isdigit(ch)

if ch = "." or dot > 1 then error_msg("bogus number")

usr_input = ch + usr_input

tokenval = val(s)

sym = "*number*"

return

end if

sym = "*unknown*"

return

end select

loop

end sub

function make_node(byval op as string, byval leftp as Tree ptr, byval rightp as Tree ptr) as Tree ptr

dim t as Tree ptr

t = callocate(len(Tree))

t->op = op

t->leftp = leftp

t->rightp = rightp

return t

end function

function is_binary(byval op as string) as integer

return op = "*" orelse op = "/" orelse op = "+" orelse op = "-"

end function

function prec(byval op as string) as integer

select case op

case "*unary minus*", "*unary plus*": return 100

case "*", "/": return 90

case "+", "-": return 80

case else: return 0

end select

end function

function primary as Tree ptr

dim t as Tree ptr = 0

select case sym

case "-", "+"

dim op as string = sym

getsym()

t = expr(prec("*unary minus*"))

if op = "-" then return make_node("*unary minus*", t, 0)

if op = "+" then return make_node("*unary plus*", t, 0)

case "("

getsym()

t = expr(0)

if sym <> ")" then error_msg("expecting rparen")

getsym()

return t

case "*number*"

t = make_node(sym, 0, 0)

t->value = tokenval

getsym()

return t

case else: error_msg("expecting a primary")

end select

end function

function expr(byval p as integer) as Tree ptr

dim t as Tree ptr = primary()

while is_binary(sym) andalso prec(sym) >= p

dim t1 as Tree ptr

dim op as string = sym

getsym()

t1 = expr(prec(op) + 1)

t = make_node(op, t, t1)

wend

return t

end function

function eval(byval t as Tree ptr) as double

if t <> 0 then

select case t->op

case "-": return eval(t->leftp) - eval(t->rightp)

case "+": return eval(t->leftp) + eval(t->rightp)

case "*": return eval(t->leftp) * eval(t->rightp)

case "/": return eval(t->leftp) / eval(t->rightp)

case "*unary minus*": return -eval(t->leftp)

case "*unary plus*": return eval(t->leftp)

case "*number*": return t->value

case else: error_msg("unexpected tree node")

end select

end if

return 0

end function

do

getsym()

if sym = "" then continue do

dim t as Tree ptr = expr(0)

print"> "; eval(t)

if sym <> "" then error_msg("unexpected input")

loop

</lang>