1local EXPTYPES = {}
  2EXPTYPES.SYMB = 1
  3EXPTYPES.CONS = 2
  4EXPTYPES.PRIM = 3
  5EXPTYPES.NMBR = 4
  6EXPTYPES.RUNE = 5
  7EXPTYPES.NIL  = 6
  8
  9local NILOBJ = {type=EXPTYPES.NIL}
 10
 11function cons(x, y)
 12	return {car=x,cdr=y}
 13end
 14
 15function makesymbol(s)
 16	return {value=s, type=EXPTYPES.SYMB}
 17end
 18
 19function makenumber(n)
 20	return {value=n, type=EXPTYPES.NMBR}
 21end
 22
 23function makecons(car, cdr)
 24	return {value=cons(car,cdr), type=EXPTYPES.CONS}
 25end
 26
 27function makeprim(fn)
 28	return {value=fn, type=EXPTYPES.PRIM}
 29end
 30
 31function getnexttok(p)
 32	if p ~= nil then
 33		GETNEXTBUFF = string.gmatch(p, "%S+")
 34	end
 35	return GETNEXTBUFF()
 36end
 37
 38function parsetok(tok)
 39	if tok == "(" then
 40		return parselist()
 41	end
 42	if tonumber(tok) ~= nil then
 43		return makenumber(tonumber(tok))
 44	end
 45	return makesymbol(tok)
 46end
 47
 48function parselist()
 49	local tok = getnexttok()
 50	if tok == nil then 
 51		error("Unmatched Parens") 
 52	end
 53	if tok == ")" then
 54		return NILOBJ
 55	end
 56	car = parsetok(tok)
 57	return makecons(car, parselist())
 58end
 59
 60function parse(prog)
 61	local tok = getnexttok(prog)
 62	return parsetok(tok)
 63end
 64
 65function fmtlist(e)
 66	if e.type == EXPTYPES.NIL then
 67		return ")"
 68	end
 69	if e.type ~= EXPTYPES.CONS then
 70		return ". " .. fmtexp(e) .. " )"
 71	end
 72	return fmtexp(e.value.car) .. " " .. fmtlist(e.value.cdr)
 73end
 74
 75function fmtexp(e)
 76	local t = e.type
 77	if t == EXPTYPES.CONS then
 78		return "( " .. fmtlist(e)
 79	end
 80	return tostring(e.value)
 81end
 82
 83local function printtable(t)
 84	if type(t) == "table" then
 85		print("{")
 86		for k, v in pairs(t) do
 87			print(tostring(k) .. ":")
 88			printtable(v)
 89		end
 90		print("}")
 91	elseif type(t) == "nil" then print(nil)
 92	else
 93		print(t)
 94	end
 95end
 96
 97-- Binds are in the form ((name, value) (name value) (name value) ...)
 98
 99local function addbind(sym, value, oldbinds)
100	return makecons(makecons(sym, value), oldbinds)
101end
102
103local function findbind(sym, binds)
104	if binds.type == EXPTYPES.NIL then error("bind doesn't exist for " .. sym.value) end
105	local curbind = binds.value.car
106	if curbind.value.car.value == sym.value then
107		return curbind.value.cdr
108	end
109	return findbind(sym, binds.value.cdr)
110end
111
112local function evallist(prog, stack, binds)
113	if prog.type == EXPTYPES.NIL then return stack end
114	local top = prog.value.car
115	local prog = prog.value.cdr
116	if top.type == EXPTYPES.SYMB then
117		top = findbind(top, binds)
118	end
119	if top.type == EXPTYPES.PRIM then
120		return top.value(prog, stack, binds)
121	end
122	return evallist(prog, makecons(top, stack), binds)
123end
124
125
126local function uncons(c)
127	return c.value.car, c.value.cdr
128end
129
130-- Start Builtins
131
132local function add2(prog, stack, binds)
133	local arg1, stack = uncons(stack)
134	local arg2, stack = uncons(stack)
135	local res = makenumber(arg1.value + arg2.value)
136	return evallist(prog, makecons(res, stack), binds)
137end
138
139local function evalbuiltin(prog, stack, binds)
140	local toeval, stack = uncons(stack)
141	stack = evallist(toeval, stack, binds)
142	return evallist(prog, stack, binds)
143end
144
145local function bindbuiltin(prog, stack, binds)
146	local sym, prog = uncons(prog)
147	local val, stack = uncons(stack)
148	return evallist(prog, stack, addbind(sym, val, binds))
149end
150
151local function execmacro(prog, stack, binds)
152	local mac, stack = uncons(stack)
153	stack = makecons(prog, stack)
154	return evallist(mac, stack, binds)
155end
156
157local function unconsbuiltin(prog, stack, binds)
158	local top, stack = uncons(stack)
159	stack = makecons(top.value.cdr, stack)
160	stack = makecons(top.value.car, stack)
161	return evallist(prog, stack, binds)
162end
163
164local function consbuiltin(prog, stack, binds)
165	local car, stack = uncons(stack)
166	local cdr, stack = uncons(stack)
167	return evallist(prog, makecons(makecons(car, cdr), stack), binds)
168end
169
170-- End Builtins
171-- Register Builtins
172
173local function getbase()
174	local base = NILOBJ
175	local function addprim(s, f)
176		base = addbind(makesymbol(s), makeprim(f), base)
177	end
178	addprim("+", add2)
179	addprim(",", evalbuiltin)
180	addprim("$", bindbuiltin)
181	addprim("uncons", unconsbuiltin)
182	addprim("cons", consbuiltin)
183	addprim("!", execmacro)
184	return base
185end
186
187-- End Register Builtins
188
189local function readfile(file) -- from stackoverflow
190	local f = assert(io.open(file, "rb"))
191	local content = f:read("*all")
192	f:close()
193	return content
194end
195
196local testterm = readfile(arg[1])
197local parsed = parse(testterm)
198local evalled = evallist(parsed, NILOBJ, getbase())
199print(fmtexp(evalled))