186 lines
4.2 KiB
Text
186 lines
4.2 KiB
Text
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
|