From 70ec5254814f9531e5ca2024465d0e01130306b7 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Wed, 21 Feb 2024 09:28:49 -0600
Subject: Initial commit

---
 eval.lua | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 145 insertions(+)
 create mode 100644 eval.lua

(limited to 'eval.lua')

diff --git a/eval.lua b/eval.lua
new file mode 100644
index 0000000..3decded
--- /dev/null
+++ b/eval.lua
@@ -0,0 +1,145 @@
+--- lam.eval
+
+local eval = {}
+local read = require "read"
+local types = require "types"
+local util = require "util"
+local pp = require "pp"
+
+Env = types.Object:new {
+	__type = "Environment",
+	__extend =
+		function(self, parms, args, outer)
+			for _, p in ipairs(parms) do
+				for _, a in ipairs(args) do
+					self[p] = a
+				end
+			end
+			getmetatable(self).__index = outer
+		end,
+}
+
+Proc = types.Object:new {
+	__type = "Procedure",
+	__call =
+		function (self, args)
+			local e = Env:new()
+			e:__extend(self.parms,
+				   util.table(args),
+				   self.env)
+			return eval(self.body[1], e)
+		end
+}
+
+global_env = Env:new {
+	-- constants
+	["#t"] = true,
+	["#f"] = false,
+	-- basic math
+	["+"] =
+		function (...)
+			print(...)
+			return util.reduce(
+				{...}, 0,
+				function (a, b) return a + b end)
+		end,
+	["*"] =
+		function (...)
+			return util.reduce(
+				{...}, 1,
+				function (a, b) return a * b end)
+		end,
+	-- scheme predicates
+	["null?"] =
+		function(x)
+			return x == {}
+		end,
+	["number?"] =
+		function(x)
+			return types.Type(x) == "Number"
+		end,
+	["symbol?"] =
+		function(x)
+			return types.Type(x) == "Symbol"
+		end,
+	-- scheme functions
+	["apply"] =
+		function(fn, ...)
+			local args = {...}
+			local last = args[#args]
+			assert(type(last)=="table", "Bad apply")
+			table.remove(args)
+			for _,v in ipairs(last) do
+				table.insert(args, v)
+			end
+			return fn(table.unpack(args))
+		end,
+	["begin"] =
+		function(...)
+			local xs = {...}
+			return xs[#xs]
+		end,
+	["map"] =
+		function(fn, ...)
+			return util.map(fn, {...})
+		end,
+	["car"] = util.car,
+	["cdr"] = util.cdr,
+	["list"] = function(...) return {...} end,
+}
+
+-- Math
+for k, v in pairs(math) do
+	global_env[k] = v
+end
+
+function eval.eval (x, env)
+	env = env or global_env
+	if types.Type(x) == "Symbol" then
+		return env[x]
+	elseif types.Type(x) ~= "List" then
+		return x
+	else
+		local op = util.car(x)
+		local args = util.cdr(x)
+		if op == "quote" then
+			return args[1]
+		elseif op == "define" then
+			local sym, exp = table.unpack(args)
+			env[sym] = eval(exp, env)
+		elseif op == "set!" then
+			local sym, exp = table.unpack(args)
+			env[sym] = eval(exp, env)
+		elseif op == "lambda" then
+			local parms = util.car(args)
+			local body = util.cdr(args)
+			return Proc:new {
+				parms = parms,
+				body = body,
+				env = env,
+			}
+		else		-- procedure call
+			pp(op)
+			local proc = eval(op, env)
+			local vals = util.map(
+				function(v) return eval(v, env) end,
+				args)
+			return proc(table.unpack(vals))
+		end
+	end
+end
+
+---
+return setmetatable(eval, { __call =
+				    function(_, x, env)
+					    local success, result =
+						    pcall(eval.eval, x, env)
+					    if success then return result
+					    else return ("ERROR: " .. result)
+					    end
+				    end
+})
+
+--[[
+	(begin (define sq (lambda (x) (* x x))) (define rep (lambda (f) (lambda (x) (f (f x))))))
+-- ]]
-- 
cgit 1.4.1-21-gabe81