6478e6b149
I'm not sure what I'm doing here just yet. This is just an experiment of the editing experience. The .tlv app doesn't actually do anything yet.
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))))
|