(phixonline)-->
with javascript_semantics
constant bFT = false -- true: use F/T, false: use 0/1, as next
function fmt(bool b)
return iff(bFT?{"F","T"}:{"0","1"})[b+1]
end function
sequence opstack = {}
object token,
op = 0 -- 0 = none
string s -- the expression being parsed
integer sidx, -- idx to ""
ch -- s[sidx]
procedure err(string msg)
printf(1,"%s\n%s^ %s\n\nPressEnter...",{s,repeat(' ',sidx-1),msg})
{} = wait_key()
abort(0)
end procedure
procedure nxtch()
sidx += 1
ch = iff(sidx>length(s)?-1:s[sidx])
end procedure
procedure skipspaces()
while find(ch," \t\r\n")!=0 do nxtch() end while
end procedure
procedure get_token()
skipspaces()
if find(ch,"()!") then
token = s[sidx..sidx]
nxtch()
else
integer tokstart = sidx
if ch=-1 then token = "eof" return end if
while 1 do
nxtch()
if ch<'A' then exit end if
end while
token = s[tokstart..sidx-1]
end if
end procedure
procedure Match(string t)
if token!=t then err(t&" expected") end if
get_token()
end procedure
procedure PopFactor()
object p2 = opstack[$]
if op="not" then
opstack[$] = {0,op,p2}
else
opstack = opstack[1..$-1]
opstack[$] = {opstack[$],op,p2}
end if
op = 0
end procedure
sequence names, -- {"false","true",...}
flags -- { 0, 1, ,...}
procedure PushFactor(string t)
if op!=0 then PopFactor() end if
integer k = find(t,names)
if k=0 then
names = append(names,t)
k = length(names)
end if
opstack = append(opstack,k)
end procedure
procedure PushOp(string t)
if op!=0 then PopFactor() end if
op = t
end procedure
forward procedure Expr(integer p)
procedure Factor()
if token="not"
or token="!" then
get_token()
Factor()
if op!=0 then PopFactor() end if
PushOp("not")
elsif token="(" then
get_token()
Expr(0)
Match(")")
elsif not find(token,{"and","or","xor"}) then
PushFactor(token)
if ch!=-1 then
get_token()
end if
else
err("syntax error")
end if
end procedure
constant {operators,
precedence} = columnize({{"not",6},
{"and",5},
{"xor",4},
{"or",3}})
procedure Expr(integer p)
Factor()
while 1 do
integer k = find(token,operators)
if k=0 then exit end if
integer thisp = precedence[k]
if thisp<p then exit end if
get_token()
Expr(thisp)
PushOp(operators[k])
end while
end procedure
function evaluate(object s)
if atom(s) then
if s>=1 then s = flags[s] end if
return s
end if
object {lhs,op,rhs} = s
lhs = evaluate(lhs)
rhs = evaluate(rhs)
if op="and" then
return lhs and rhs
elsif op="or" then
return lhs or rhs
elsif op="xor" then
return lhs xor rhs
elsif op="not" then
return not rhs
else
?9/0
end if
end function
function next_comb()
integer fdx = length(flags)
while flags[fdx]=1 do
flags[fdx] = 0
fdx -= 1
end while
if fdx<=2 then return false end if -- all done
flags[fdx] = 1
return true
end function
procedure test(string expr)
opstack = {}
op = 0
names = {"false","true"}
s = expr
sidx = 0
nxtch()
get_token()
Expr(0)
if op!=0 then PopFactor() end if
if length(opstack)!=1 then err("some error") end if
flags = repeat(0,length(names))
flags[2] = 1 -- set "true" true
printf(1,"%s %s\n",{join(names[3..$]),s})
while 1 do
for i=3 to length(flags) do -- (skipping true&false)
printf(1,"%s%s",{fmt(flags[i]),repeat(' ',length(names[i]))})
end for
printf(1," %s\n",{fmt(evaluate(opstack[1]))})
if not next_comb() then exit end if
end while
puts(1,"\n")
end procedure
test("young and not (ugly or poor)")
if platform()!=JS then -- (no gets(0) in a browser)
while 1 do
puts(1,"input expression:")
string t = trim(gets(0))
puts(1,"\n")
if t="" then exit end if
test(t)
end while
end if