232 lines
5.0 KiB
Lua
232 lines
5.0 KiB
Lua
-- atom types:
|
|
-- nil
|
|
-- true
|
|
-- {num=3.4}
|
|
-- {char='a'}
|
|
-- {str='bc'}
|
|
-- {sym='foo'}
|
|
-- non-atom type:
|
|
-- {car={num=3.4}, cdr=nil}
|
|
--
|
|
-- should {} mean anything special? currently just '(nil)
|
|
function atom(x)
|
|
return x == nil or x.num or x.char or x.str or x.sym
|
|
end
|
|
|
|
function car(x) return x.car end
|
|
function cdr(x) return x.cdr end
|
|
function cons(x, y) return {car=x, cdr=y} end
|
|
|
|
function iso(x, y)
|
|
if x == nil then return y == nil end
|
|
local done={}
|
|
if done[x] then return done[x] == y end
|
|
done[x] = y
|
|
if atom(x) then
|
|
if not atom(y) then return nil end
|
|
for k, v in pairs(x) do
|
|
if y[k] ~= v then return nil end
|
|
end
|
|
return true
|
|
end
|
|
for k, v in pairs(x) do
|
|
if not iso(y[k], v) then return nil end
|
|
end
|
|
for k, v in pairs(y) do
|
|
if not iso(x[k], v) then return nil end
|
|
end
|
|
return true
|
|
end
|
|
|
|
-- primitives; feel free to add more
|
|
-- format: lisp name = lua function that implements it
|
|
unary_functions = {
|
|
atom=atom,
|
|
car=car,
|
|
cdr=cdr,
|
|
}
|
|
|
|
binary_functions = {
|
|
cons=cons,
|
|
iso=iso,
|
|
}
|
|
|
|
function lookup(env, s)
|
|
if env[s] then return env[s] end
|
|
if env.next then return lookup(env.next, s) end
|
|
end
|
|
|
|
function eval(x, env)
|
|
function symeq(x, s)
|
|
return x and x.sym == s
|
|
end
|
|
if x.sym then
|
|
return lookup(env, x.sym)
|
|
elseif atom(x) then
|
|
return x
|
|
-- otherwise x is a pair
|
|
elseif symeq(x.car, 'quote') then
|
|
return x.cdr
|
|
elseif unary_functions[x.car.sym] then
|
|
return eval_unary(x, env)
|
|
elseif binary_functions[x.car.sym] then
|
|
return eval_binary(x, env)
|
|
-- special forms that don't always eval all their args
|
|
elseif symeq(x.car, 'if') then
|
|
return eval_if(x, env)
|
|
elseif symeq(x.car.car, 'fn') then
|
|
return eval_fn(x, env)
|
|
elseif symeq(x.car.car, 'label') then
|
|
return eval_label(x, env)
|
|
end
|
|
end
|
|
|
|
function eval_unary(x, env)
|
|
return unary_functions[x.car.sym](eval(x.cdr.car, env))
|
|
end
|
|
|
|
function eval_binary(x, env)
|
|
return binary_functions[x.car.sym](eval(x.cdr.car, env),
|
|
eval(x.cdr.cdr.car, env))
|
|
end
|
|
|
|
function eval_if(x, env)
|
|
-- syntax: (if check b1 b2)
|
|
local check = x.cdr.car
|
|
local b1 = x.cdr.cdr.car
|
|
local b2 = x.cdr.cdr.cdr.car
|
|
if eval(check, env) then
|
|
return eval(b1, env)
|
|
else
|
|
return eval(b2, env)
|
|
end
|
|
end
|
|
|
|
function eval_fn(x, env)
|
|
-- syntax: ((fn params body*) args*)
|
|
local callee = x.car
|
|
local args = x.cdr
|
|
local params = callee.cdr.car
|
|
local body = callee.cdr.cdr
|
|
return eval_exprs(body,
|
|
bind_env(params, args, env))
|
|
end
|
|
|
|
function bind_env(params, args, env)
|
|
if params == nil then return env end
|
|
local result = {next=env}
|
|
while true do
|
|
result[params.car.sym] = eval(args.car, env)
|
|
params = params.cdr
|
|
args = args.cdr
|
|
if params == nil then break end
|
|
end
|
|
return result
|
|
end
|
|
|
|
function eval_exprs(xs, env)
|
|
local result = nil
|
|
while xs do
|
|
result = eval(xs.car, env)
|
|
xs = xs.cdr
|
|
end
|
|
return result
|
|
end
|
|
|
|
function eval_label(x, env)
|
|
-- syntax: ((label f (fn params body*)) args*)
|
|
local callee = x.car
|
|
local args = x.cdr
|
|
local f = callee.cdr.car
|
|
local fn = callee.cdr.cdr.car
|
|
return eval({car=fn, cdr=args},
|
|
bind_env({f}, {callee}, env))
|
|
end
|
|
|
|
-- testing
|
|
function num(n) return {num=n} end
|
|
function char(c) return {char=c} end
|
|
function str(s) return {str=s} end
|
|
function sym(s) return {sym=s} end
|
|
function list(...)
|
|
-- gotcha: no element in arg can be nil; that short-circuits the ipairs below
|
|
local result = nil
|
|
local curr = nil
|
|
for _, x in ipairs({...}) do
|
|
if curr == nil then
|
|
result = {car=x}
|
|
curr = result
|
|
else
|
|
curr.cdr = {car=x}
|
|
curr = curr.cdr
|
|
end
|
|
end
|
|
return result
|
|
end
|
|
|
|
function p(x)
|
|
p2(x)
|
|
print()
|
|
end
|
|
|
|
function p2(x)
|
|
if x == nil then
|
|
io.write('nil')
|
|
elseif x == true then
|
|
io.write('true')
|
|
elseif x.num then
|
|
io.write(x.num)
|
|
elseif x.char then
|
|
io.write("\\"..x.char)
|
|
elseif x.str then
|
|
io.write('"'..x.str..'"')
|
|
elseif x.sym then
|
|
io.write(x.sym)
|
|
elseif x.cdr == nil then
|
|
io.write('(')
|
|
p2(x.car)
|
|
io.write(')')
|
|
elseif atom(x.cdr) then
|
|
io.write('(')
|
|
p2(x.car)
|
|
io.write(' . ')
|
|
p2(x.cdr)
|
|
io.write(')')
|
|
else
|
|
io.write('(')
|
|
while true do
|
|
p2(x.car)
|
|
x = x.cdr
|
|
if x == nil then break end
|
|
if atom(x) then
|
|
io.write(' . ')
|
|
p2(x)
|
|
break
|
|
end
|
|
io.write(' ')
|
|
end
|
|
io.write(')')
|
|
end
|
|
end
|
|
|
|
x = {num=3.4}
|
|
p(x)
|
|
|
|
p(cons(x, nil))
|
|
p(list(x))
|
|
|
|
p(iso(cons(x, nil), cons(x, nil)))
|
|
p(iso(list(x), list(x)))
|
|
p(iso(list(x, x), list(x)))
|
|
p(iso(list(x, x), list(x, x)))
|
|
p(iso(x, cons(x, nil)))
|
|
|
|
p (list(sym("cons"), num(42), num(1)))
|
|
p(eval(list(sym("cons"), num(42), num(1)), {}))
|
|
|
|
-- ((fn () 42)) => 42
|
|
-- can't use list here because of the gotcha above
|
|
assert(iso(eval(cons(cons(sym('fn'), cons(nil, cons(num(42))))), {}), num(42)))
|
|
-- ((fn (a) (cons a 1)) 42) => '(42 . 1)
|
|
assert(iso(eval(cons(cons(sym('fn'), cons(cons(sym('a')), cons(cons(sym('cons'), cons(sym('a'), cons(num(1))))))), cons(num(42)))), cons(num(42), num(1))))
|