Skip to content

Instantly share code, notes, and snippets.

@juster

juster/lisp.lua

Created November 28, 2014 21:14
Show Gist options
  • Save juster/720fc757517fa59485f4 to your computer and use it in GitHub Desktop.
Save juster/720fc757517fa59485f4 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
lisp.lua
-- lisp.lua
-- by Justin Davis <jrcd83@gmail.com>
-- Very light data abstraction.
local nullval = {}
local function pair_exp (exp)
return type(exp) == "table" and exp.left ~= nil and exp.right ~= nil
end
local list_exp = pair_exp
local function pair_left (exp)
return exp.left
end
local function pair_right (exp)
return exp.right
end
local function list_str (p)
local function tostr (p)
if p.right == nullval then
return p.left .. ")"
elseif pair_exp(p.right) then
return p.left .. " " .. tostr(p.right)
else
return p.left .. " . " .. p.right .. ")"
end
end
return "(" .. tostr(p)
end
local listmt = { __tostring = list_str }
local function make_pair (a, b)
local exp = { left = a; right = b}
setmetatable(exp, listmt)
return exp
end
local function symbol_exp (exp)
return type(exp) == "table" and exp.symbol ~= nil
end
local function symbol_name (exp)
if symbol_exp(exp) then return exp.symbol
else return nil
end
end
local symmt = { __tostring = symbol_name }
local function make_symbol (name)
local exp = { symbol = name }
setmetatable(exp, symmt)
return exp
end
local function null_exp (exp) return exp == nullval end
local function newenv (arg, vars, parenv)
if arg.n ~= #vars then
error("Invalid number of arguments given to lambda expression")
end
local env = {}
for i = 1, arg.n do
env[symbol_name(vars[i])] = arg[i]
end
setmetatable(env, { __index = parenv })
return env
end
local function exptostr (exp)
if (symbol_exp(exp)) then
return symbol_name(exp)
elseif (null_exp(exp)) then
return "nil"
elseif type(exp) == "string" then
return '"' .. exp .. '"'
else
return exp
end
end
-- Global primitive procedures.
local E
E = {
cons = function (a, b)
return make_pair(a, b)
end;
car = function (a)
if not pair_exp(a) then error("parameter to car is not a pair")
else return pair_left(a)
end
end;
cdr = function (a)
if not pair_exp(a) then error("parameter to car is not a pair")
else return pair_right(a)
end
end;
display = function (a) print(exptostr(a)) end;
list = function (hd, ...)
if hd == nil then return nullval
else return E.cons(hd, E.list(unpack(arg)))
end
end;
["nil"] = nullval;
["null?"] = null_exp;
["not"] = function (a)
if null_exp(a) then return true
else return (not a)
end
end;
["list?"] = function (a) return list_exp(a) or null_exp(a) end;
["symbol?"] = symbol_exp;
["*"] = function (a, b) return a * b end;
["/"] = function (a, b) return a / b end;
["+"] = function (a, b) return a + b end;
["-"] = function (a, b) return a - b end;
["<"] = function (a, b) return a < b end;
[">"] = function (a, b) return a > b end;
["<="] = function (a, b) return a <= b end;
[">="] = function (a, b) return a >= b end;
["="] = function (a, b) return a == b end;
} -- ends E
-- Evaluate an expression in a given environment.
local function eval (x, env)
local function make_lambda (vars, exp)
return function (...) return eval(exp, newenv(arg, vars, env)) end
end
local builtins = {
["quote"] = function (s)
return s
end;
["if"] = function (test, conseq, alt)
if eval(test, env) then
return eval(conseq, env)
elseif alt ~= nil then
return eval(alt, env)
else
return nil
end
end;
["set!"] = function (var, exp)
local n = symbol_name(var)
if env[n] == nil then error("Unbound variable " .. n) end
env[n] = eval(exp, env)
return nullval
end;
["define"] = function (var, exp)
-- Rewrite define's with list parameters ie:
-- (define (x y) ...) => (define x (lambda (y) ...))
if symbol_exp(var) then
env[symbol_name(var)] = eval(exp, env)
elseif type(var) == "table" then
local sym = var[1]
table.remove(var, 1)
env[symbol_name(sym)] = make_lambda(var, exp)
end
return nullval
end;
["lambda"] = make_lambda;
["begin"] = function (...)
local val
for i = 1, arg.n do val = eval(arg[i], env) end
return val
end
}
local t = type(x)
if t == "number" or t == "boolean" or t == "string" then
return x
elseif symbol_exp(x) then
local n = symbol_name(x)
local v = env[n]
if v == nil then error("Unbound variable " .. n) end
return v
elseif builtins[symbol_name(x[1])] ~= nil then
return builtins[symbol_name(x[1])](select(2, unpack(x)))
else
local proc = eval(x[1], env)
local exps = {}
for i = 2, #x do
exps[i-1] = eval(x[i], env)
end
return proc(unpack(exps))
end
end
local function tokenize (str)
local nop = function (tok) return nil end
local pass = function (tok) return tok end
local acts = {
'[0-9a-zA-Z_!@#$%%^&*=+./\\{}[%]<>\'?-]+', pass, "%s+", nop,
"[%(%)]", pass, '%b""', pass,
}
local beg = 1
local function L ()
if beg > str:len() then return nil end
for i = 1, #acts-1, 2 do
local x, y = str:find("^" .. acts[i], beg)
if x ~= nil then
beg = y+1
local tok = acts[i+1](str:sub(x, y))
if tok == nil then return L()
else return tok
end
end
end
error("Invalid string starting at pos " .. beg)
end
return L
end
local function tokreader ()
local function rdr (cont)
if cont then io.write("...> ") else io.write("lisp> ") end
local s = io.read()
if s == nil then return nil
else return tokenize(s)
end
end
return rdr
end
local function atom (tok)
if tok:match('^"') then return tok:sub(2, -2)
elseif tonumber(tok) ~= nil then return tonumber(tok)
elseif tok == "true" then return true
elseif tok == "false" then return false
else return make_symbol(tok)
end
end
-- Scan expressions from standard input (using tokrdr).
local function scanner (tokrdr)
local S = { {} }
local push = table.insert
local function scan()
local iter = tokrdr(#S > 1)
if iter == nil then return nil end
for t in iter do
-- Push a new empty list to the top of the stack.
if t == "(" then push(S, {})
elseif t == ")" then
-- Pop the top list off the stack and append it to the list
-- below it (which is now the top of the stack).
if #S > 1 then push(S[#S - 1], S[#S]); S[#S] = nil
else error("Unbalanced parenthesis")
end
-- Append an atom to the top-most list.
else push(S[#S], atom(t))
end
end
local exps = S[1]; S[1] = {}
if #exps == 0 and #S == 1 then return nil
else return exps
end
end
return scan
end
function repl ()
local scan = scanner(tokreader())
while true do
local exps = scan()
if exps == nil then
print("\ngoodbye")
break
elseif #exps > 0 then
for _, exp in ipairs(exps) do
local win, v = pcall(eval, exp, E)
if win then v = exptostr(v) end
print(v)
end
end
end
end
repl()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment