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

---
 global.lua | 141 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 141 insertions(+)
 create mode 100644 global.lua

(limited to 'global.lua')

diff --git a/global.lua b/global.lua
new file mode 100644
index 0000000..3805912
--- /dev/null
+++ b/global.lua
@@ -0,0 +1,141 @@
+--- lam.environment
+
+local util = require "util"
+local types = require("types")
+
+if not table.unpack then table.unpack = unpack end
+
+local global = {
+	-- constants
+	["#t"] = true,
+	["#f"] = false,
+}
+
+--- Types ---
+
+for name, func in pairs(types) do
+	if name == "lamtype" then
+		global.type = func
+	else
+		global[name] = func
+	end
+end
+
+--- Basic functions ---
+
+global.begin = function(...)
+	local xs = {...}
+	return xs[#xs]
+end
+
+global.car = util.car
+global.cdr = util.cdr
+
+global.list = function(...) return {...} end
+
+--- Higher-order functions ---
+
+global.apply = function(fn, ...)
+	local args = {...}
+	local last = args[#args]
+	assert(types.luatype(last) == "table", "Bad apply")
+	table.remove(args)
+	for _, v in ipairs(last) do
+		table.insert(args, v)
+	end
+	return fn(table.unpack(args))
+end
+
+global.map = function(fn, list)
+	return util.map(fn, list)
+end
+
+--- Math ---
+-- NOTE: we do not have the full numeric tower yet!
+
+for name, func in pairs(math) do
+	global[name] = func
+end
+
+global["+"] = function (...)
+	return util.reduce({...}, 0, function (a, b) return a + b end)
+end
+
+global["-"] = function (...)
+	local args = {...}
+	if #args == 0 then
+		error("Too few arguments: need at least 1")
+	elseif #args == 1 then
+		return (-args[1])
+	else
+		local result = args[1]
+		for v = 2, #args do
+			result = result - args[v]
+		end
+		return result
+	end
+end
+
+global["*"] = function (...)
+	local result = 1
+	for _, v in ipairs({...}) do
+		if v == 0 then return 0 end
+		result = result * v
+	end
+	return result
+end
+
+global["/"] = function (...)
+	local args = {...}
+	if #args == 0 then
+		error("Too few arguments: need at least 1")
+	elseif #args == 1 then
+		if args[1] == 0 then error("Division by zero") end
+		return (1/args[1])
+	else
+		local result = args[1]
+		for v = 2, #args do
+			if args[v] == 0 then error("Division by zero") end
+			result = result / args[v]
+		end
+		return result
+	end
+end
+
+global["="] = function (...)
+	for _, v in ipairs({...}) do
+		if not a == b then return false end
+	end
+	return true
+end
+
+global["<"] = function (...)
+	for _, v in ipairs({...}) do
+		if not a < b then return false end
+	end
+	return true
+end
+
+global["<="] = function (...)
+	for _, v in ipairs({...}) do
+		if not a <= b then return false end
+	end
+	return true
+end
+
+global[">"] = function (...)
+	for _, v in ipairs({...}) do
+		if not a > b then return false end
+	end
+	return true
+end
+
+global[">="] = function (...)
+	for _, v in ipairs({...}) do
+		if not a >= b then return false end
+	end
+	return true
+end
+
+---
+return global
-- 
cgit 1.4.1-21-gabe81