From 5328b62221a3839dca117d71a4703f3ad719c9ce Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Thu, 22 Feb 2024 00:23:32 -0600
Subject: Add global and types libraries

---
 eval.lua | 119 ++++++++++++---------------------------------------------------
 1 file changed, 22 insertions(+), 97 deletions(-)

(limited to 'eval.lua')

diff --git a/eval.lua b/eval.lua
index d441859..cdf4612 100644
--- a/eval.lua
+++ b/eval.lua
@@ -4,23 +4,10 @@ local eval = {}
 local read = require "read"
 local util = require "util"
 local pp = require "pp"
+local global = require "global"
+local types = require("types")
 
-local function Type (x)
-	if type(x) == "string" then
-		return "Symbol"
-	elseif type(x) == "number" then
-		return "Number"
-	elseif getmetatable(x) and getmetatable(x).__type then
-		return x.__type
-	elseif type(x) == "table" then
-		return "List"
-	else
-		return type(x)
-	end
-end
-
-local Symbol = tostring
-local Number = tonumber
+if not table.unpack then table.unpack = unpack end
 
 local function Env(inner, outer)
 	return setmetatable(inner, { __type = "Environment", __index = outer, })
@@ -48,73 +35,11 @@ local function Proc(params, body, env)
 	return setmetatable(p, mt)
 end
 
-local global_env = {
-	-- 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 Type(x) == "Number"
-		end,
-	["symbol?"] =
-		function(x)
-			return 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 Type(x) == "Symbol" then
-		return env[x]
-	elseif type(x) ~= "table" then
+function eval.eval (x, e)
+	e = e or global
+	if types.lamtype(x) == "Symbol" then
+		return e[x]
+	elseif types.luatype(x) ~= "table" then
 		return x
 	else
 		local op = util.car(x)
@@ -123,20 +48,24 @@ function eval.eval (x, env)
 			return args[1]
 		elseif op == "define" then
 			local sym, exp = table.unpack(args)
-			env[sym] = eval(exp, env)
+			e[sym] = eval(exp, e)
 			--[[
 				elseif op == "set!" then
 				local sym, exp = table.unpack(args)
-				env[sym] = eval(exp, env) --]]
+				e[sym] = eval(exp, e) --]]
 		elseif op == "lambda" then
 			local params = util.car(args)
-			local body = util.cdr(args)[1]
-			return Proc(params, body, env)
+			local body = util.cdr(args)
+			table.insert(body, 1, "begin")
+			return Proc(params,
+				    body,
+				    e)
 		else		-- procedure call
-			local proc = eval(op, env)
-			local vals = util.map(
-				function(v) return eval(v, env) end,
-				args)
+			local proc = eval(op, e)
+			local vals = {}
+			for k, v in pairs(args) do
+				vals[k] = eval(v, e)
+			end
 			return proc(table.unpack(vals))
 		end
 	end
@@ -144,15 +73,11 @@ end
 
 ---
 return setmetatable(eval, { __call =
-				    function(_, x, env)
+				    function(_, x, e)
 					    local success, result =
-						    pcall(eval.eval, x, env)
+						    pcall(eval.eval, x, e)
 					    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