From bbaff0e0c204c2fab216f6501dc8c11b4425b4bc Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Mon, 4 Mar 2024 21:01:27 -0600
Subject: Ugghhhh totally not working

---
 eval.lua   |  18 +++++----
 eval2.lua  |  39 ++++++++++++++++++++
 global.lua |  91 +++++++++++++++++++++++++++------------------
 list.lua   |  48 ++++++++++++++++++++++++
 port.lua   |  20 ++++++++++
 pp.lua     |  22 +++++++++--
 read.lua   |  93 ++++++++++++++++++++++++++--------------------
 repl.lua   |   1 +
 types.lua  | 122 +++++++++++++++++++++++++++++++++++++++++++++++++++----------
 util.lua   |   1 +
 10 files changed, 350 insertions(+), 105 deletions(-)
 create mode 100644 eval2.lua
 create mode 100644 list.lua
 create mode 100644 port.lua

diff --git a/eval.lua b/eval.lua
index 185268f..806148d 100644
--- a/eval.lua
+++ b/eval.lua
@@ -5,12 +5,14 @@ local read = require "read"
 local util = require "util"
 local pp = require "pp"
 local global = require "global"
-local types = require("types")
+local types = require "types"
+table.unpack = table.unpack or unpack
 
-if not table.unpack then table.unpack = unpack end
+--- Environments and Parameters
+-- these aren't in types.lua to avoid a circular dependency
 
 local function Env(inner, outer)
-	return setmetatable(inner, { __type = "environment", __index = outer, })
+	return setmetatable(inner, { __type = "Environment", __index = outer, })
 end
 
 local function Proc(params, body, env)
@@ -20,7 +22,7 @@ local function Proc(params, body, env)
 		env = env,
 	}
 	local mt = {
-		__type = "procedure",
+		__type = "Procedure",
 		__call =
 			function (self, ...)
 				local inner = {}
@@ -37,23 +39,23 @@ end
 
 function eval.eval (x, e)
 	e = e or global
-	if types.lamtype(x) == "symbol" then
+	if types.lamtype(x) == "Symbol" then
 		return e[x]
 	elseif types.luatype(x) ~= "table" then
 		return x
 	else
 		local op = util.car(x)
 		local args = util.cdr(x)
-		if op == "quote" then
+		if op == types.Symbol("quote") then
 			return args[1]
-		elseif op == "define" then
+		elseif op == types.Symbol("define") then
 			local sym, exp = table.unpack(args)
 			e[sym] = eval(exp, e)
 			--[[
 				elseif op == "set!" then
 				local sym, exp = table.unpack(args)
 				e[sym] = eval(exp, e) --]]
-		elseif op == "lambda" then
+		elseif op == types.Symbol("lambda") then
 			local params = util.car(args)
 			local body = util.cdr(args)
 			table.insert(body, 1, "begin")
diff --git a/eval2.lua b/eval2.lua
new file mode 100644
index 0000000..02444b8
--- /dev/null
+++ b/eval2.lua
@@ -0,0 +1,39 @@
+--- lam.eval
+
+local eval = {}
+local read = require "read"
+local util = require "util"
+local types = require "types"
+table.unpack = table.unpack or unpack
+
+local Environment =
+	function (inner, outer)
+		-- an Environment is really just a lua table between symbols and
+		-- values.  They can be nested for uh, closure reasons or
+		-- something.  TODO: figure out how this intersects with
+		-- Namespaces or Symboltables or whatever.
+		local mt = {
+			__type = "Environment",
+			__index = outer,
+		}
+		return setmetatable(inner, mt)
+	end
+
+local Procedure =
+	function (params, body, env)
+		local proc = {
+			params = params,
+			body = body,
+			env = env,
+		}
+		local mt = {
+			__type = "Procedure",
+			__call =
+				function (self, ...)
+				end,
+		}
+		return setmetatable(proc, mt)
+	end
+
+---
+return eval
diff --git a/global.lua b/global.lua
index 3805912..1dea773 100644
--- a/global.lua
+++ b/global.lua
@@ -1,40 +1,47 @@
 --- lam.environment
 
 local util = require "util"
-local types = require("types")
-
-if not table.unpack then table.unpack = unpack end
+local types = require "types"
+table.unpack = table.unpack or unpack
 
 local global = {
-	-- constants
+	-- constants ---- TODO this should be at the reader level
 	["#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
+global.luatype = type
+global.type = types.lamtype
+
+global["number?"] = function (x) types.isa(x, "Number") end
+global["string?"] = function (x) types.isa(x, "String") end
+global["symbol?"] = function (x) types.isa(x, "Symbol") end
+global["pair?"] = function (x) types.isa(x, "Pair") end
+global["is-a?"] = function (x, t) types.isa(x, t) end
 
 --- Basic functions ---
 
-global.begin = function(...)
-	local xs = {...}
-	return xs[#xs]
-end
+global.car = function (pair) return pair[1] end
+global.cdr = function (pair) return pair[2] end
 
-global.car = util.car
-global.cdr = util.cdr
+-- global.list = types.List
 
-global.list = function(...) return {...} end
+global["list?"] =
+	function (x)
+		-- TODO : detect circular lists
+		if type(x) == "table" then
+			if #x == 0 then return true end
+			if type(x[2]) ~= "table" then return false end
+		end
+		return global["list?"](x[2])
+	end
 
---- Higher-order functions ---
+global["null?"] = function (x) return type(x) == "table" and #x == 0 end
 
+--- Higher-order functions ---
+--[[
 global.apply = function(fn, ...)
 	local args = {...}
 	local last = args[#args]
@@ -49,7 +56,7 @@ end
 global.map = function(fn, list)
 	return util.map(fn, list)
 end
-
+--]]
 --- Math ---
 -- NOTE: we do not have the full numeric tower yet!
 
@@ -57,7 +64,15 @@ for name, func in pairs(math) do
 	global[name] = func
 end
 
-global["+"] = function (...)
+global.fold =
+	function (fn, lis)
+		local out = {}
+
+		return types.List(out)
+	end
+
+global["+"] = function (lis)
+	return
 	return util.reduce({...}, 0, function (a, b) return a + b end)
 end
 
@@ -102,40 +117,46 @@ global["/"] = function (...)
 	end
 end
 
-global["="] = function (...)
-	for _, v in ipairs({...}) do
-		if not a == b then return false end
+--[[
+global["="] =
+	function (...)
+		for _, v in ipairs({...}) do
+			if not a == b then return false end
+		end
+		return true
 	end
-	return true
-end
 
-global["<"] = function (...)
-	for _, v in ipairs({...}) do
-		if not a < b then return false end
+global["<"] =
+	function (...)
+		for _, v in ipairs({...}) do
+			if not a < b then return false end
+		end
+		return true
 	end
-	return true
-end
 
-global["<="] = function (...)
+global["<="] =
+	function (...)
 	for _, v in ipairs({...}) do
 		if not a <= b then return false end
 	end
 	return true
 end
 
-global[">"] = function (...)
+global[">"] =
+	function (...)
 	for _, v in ipairs({...}) do
 		if not a > b then return false end
 	end
 	return true
 end
 
-global[">="] = function (...)
+global[">="] =
+	function (...)
 	for _, v in ipairs({...}) do
 		if not a >= b then return false end
 	end
 	return true
 end
-
+--]]
 ---
 return global
diff --git a/list.lua b/list.lua
new file mode 100644
index 0000000..1153c26
--- /dev/null
+++ b/list.lua
@@ -0,0 +1,48 @@
+--- lam.list
+
+local list = {}
+local util = require "util"
+local types = require "types"
+table.unpack = table.unpack or unpack
+
+list.Null = setmetatable({}, {
+		__type = "Null",
+		__tostring = function(self) return "()" end,
+})
+
+list.isNull =
+	function (x)
+		return x == list.Null
+	end
+
+list.List =
+	function (tbl)
+		local function tolist (base, items)
+			if #items == 0 then return base end
+			return tolist (
+				types.Cons(table.remove(items), base),
+				items
+			)
+		end
+		return tolist(list.Null, tbl)
+	end
+
+list.isList =
+	function (x)
+		if list.isNull(x) then
+			return true
+		elseif types.isa(x, "Pair") then
+			return list.isList(x[2])
+		else
+			return false
+		end
+	end
+
+list.fold1 =
+	function (fn, seed, lis)
+		if list.isNull(lis) then return seed end
+		return list.fold1(fn, fn(seed, lis[1]), lis[2])
+	end
+
+---
+return list
diff --git a/port.lua b/port.lua
new file mode 100644
index 0000000..c5763df
--- /dev/null
+++ b/port.lua
@@ -0,0 +1,20 @@
+--- lam.port
+
+local port = {}
+table.unpack = table.unpack or unpack
+
+function port.Input (file)
+	return {
+		file = file,
+		line = "",
+	}
+end
+
+port.tokenizer = "%s*(,@|[('`,)]|)"
+
+function port.Input:tokens () -- iterator
+
+end
+
+---
+return port
diff --git a/pp.lua b/pp.lua
index 85d323e..9c1a6d0 100644
--- a/pp.lua
+++ b/pp.lua
@@ -3,11 +3,27 @@
 local pp = {}
 table.unpack = table.unpack or unpack
 
+pp.luadump =
+	function (x)
+	end
+
+pp.luapp = function (x) print(pp.luadump(x)) end
+
+pp.lamdump =
+	function (x)
+	end
+
+pp.lampp = function (x) print(pp.lamdump(x)) end
+
+-- The following should be at some point replaced by the preceding
+
 function pp.dump (x, lvl)
 	lvl = lvl or 0
 	local space = string.rep(" ", lvl)
 	local output = ""
-	if type(x) == "table" then
+	--[[if getmetatable(x) and getmetatable(x).__tostring then
+		output = output .. tostring(x)
+		else]]if type(x) == "table" then
 		local subo = ""
 		for k,v in pairs(x) do
 			if v == x then
@@ -20,10 +36,8 @@ function pp.dump (x, lvl)
 		end
 		output = output .. string.format("\n%s{%s\n%s}",
 			space, subo, space)
-	elseif type(x) == "string" then
-		output = output .. string.format("'%s'", x)
 	else
-		output = output .. string.format("%s", x)
+		output = output .. tostring(x)
 	end
 	return output
 end
diff --git a/read.lua b/read.lua
index c89261c..00a2d2a 100644
--- a/read.lua
+++ b/read.lua
@@ -2,6 +2,7 @@
 
 local read = {}
 local utf8 = require "utf8"
+local types = require "types"
 table.unpack = table.unpack or unpack
 
 local string_to_table =
@@ -13,7 +14,36 @@ local string_to_table =
 		return tbl
 	end
 
-local bslash = { -- backslash characters
+local consume_whitespace =
+	function (chars)
+		local s = {"\\"} -- accumulator for if there's no \n
+		while chars[1]:match("[ \t]") do
+			table.insert(s, util.pop(chars))
+		end
+		if chars[1] ~= "\n" then
+			table.insert(s, chars[1])
+			return table.concat(s), chars
+		end
+		while chars[1]:match("%s") do
+			util.pop(chars)
+		end
+		return chars[1], chars
+	end
+
+local consume_hexvalue =
+	function (chars)
+		local u8ch = {}
+		repeat
+			local c = util.pop(chars)
+			table.insert(u8ch,c)
+		until c == ";"
+		table.remove(u8ch) -- remove semicolon
+		return
+			utf8.char(tonumber(table.concat(u8ch), 16)),
+			chars
+	end
+
+local string_bslash = { -- backslash characters
 	a = "\a",
 	b = "\b",
 	t = "\t",
@@ -22,23 +52,12 @@ local bslash = { -- backslash characters
 	["\""] = "\"",
 	["\\"] = "\\",
 	["|"] = "|",
-
-	-- TODO: whitespace
-	-- \<intraline whitespace>*<line ending> <intraline whitespace>* :
-	-- nothing
-
-	x = -- \x<hex scalar value>; : specified character
-		function (chars)
-			local u8ch = {}
-			repeat
-				local c = util.pop(chars)
-				table.insert(u8ch,c)
-			until c == ";"
-			table.remove(u8ch) -- remove semicolon
-			return
-				utf8.char(tonumber(table.concat(u8ch), 16)),
-				chars
-		end,
+	-- \<intraline ws>*<line ending> <intraline ws>* : nothing
+	[" "] = consume_whitespace,
+	["\t"] = consuem_whitespace,
+	["\n"] = consume_whitespace,
+	-- \x<hex scalar value>; : specified character
+	x = consume_hexvalue,
 }
 
 local consume_string =
@@ -47,17 +66,22 @@ local consume_string =
 		repeat
 			local c = util.pop(chars)
 			if c == "\\" then
-				c = util.pop(chars)
-				if bslash[c] then
-					if type(bslash[c]) == "function" then
-						c, chars = bslash[c](chars)
+				c = chars[1]
+				if string_bslash[c] then
+					if type(string_bslash[c]) == "function"
+					then
+						c, chars =
+							string_bslash[c](chars)
 						table.insert(str, c)
 					else
-						table.insert(str, bslash[c])
+						table.insert(
+							str,
+							string_bslash[c])
 					end
 				else
 					table.insert(str, "\\"..c)
 				end
+				util.pop(chars)
 			elseif c == "\"" then
 				break
 			else
@@ -114,18 +138,9 @@ read.tokenize =
 	end
 
 read.tokentable = {
-	string =
-		function (tok)
-			return tok.value
-		end,
-	number =
-		function (tok)
-			return tonumber(tok.value)
-		end,
-	symbol =
-		function (tok)	-- TODO need to return a Symbol from types...
-			return tok.value
-		end,
+	string = function (tok) return types.String(tok.value) end,
+	number = function (tok) return types.Number(tok.value) end,
+	symbol = function (tok) return types.Symbol(tok.value) end,
 }
 
 read.parse =
@@ -138,7 +153,7 @@ read.parse =
 				table.insert(L, read.parse(tokens))
 			end
 			util.pop(tokens) -- remove ")"
-			return L
+			return types.List(table.unpack(L))
 		elseif tok.value == ")" then
 			error("Unexpected ')'")
 		elseif read.tokentable[tok.type] then
@@ -152,7 +167,7 @@ read.read = function (program) return read.parse(read.tokenize(program)) end
 
 ---
 return setmetatable(read, { __call =
-				    function(_, program)
-					    return read.read(program)
-				    end,
+			function(_, program)
+				return read.read(program)
+			end,
 })
diff --git a/repl.lua b/repl.lua
index 3cdfe4e..a89fd2c 100644
--- a/repl.lua
+++ b/repl.lua
@@ -4,6 +4,7 @@ local repl = {}
 local eval = require "eval"
 local read = require "read"
 local util = require "util"
+table.unpack = table.unpack or unpack
 
 function schemestr(x)
 	if type(x) == "table" then
diff --git a/types.lua b/types.lua
index d4c8d14..e4813b2 100644
--- a/types.lua
+++ b/types.lua
@@ -1,28 +1,112 @@
 --- lam.types
 
 local types = {}
+local util = require "util"
+table.unpack = table.unpack or unpack
 
-types.luatype = type
-
-function types.lamtype (x)
-	if types.luatype(x) == "string" then
-		return "symbol"
-	elseif types.luatype(x) == "number" then
-		return "number"
-	elseif getmetatable(x) and getmetatable(x).__type then
-		return getmetatable(x).__type
-	elseif types.luatype(x) == "table" then
-		return "list"
-	else
-		return types.luatype(x)
+--- Converting between types
+
+types.globalns = {}		-- namespace
+
+types.Symbol =
+	function (name, ns, aliases)
+		ns = ns or types.globalns
+		aliases = aliases or {}
+		if ns[name] then return ns[name] end
+		local sym = { name = name, aliases = aliases }
+		ns[name] = sym
+		for _,a in ipairs(aliases) do
+			ns[a] = sym
+		end
+		local mt = {
+			__type = "Symbol",
+			__tostring = function (self) return self.name end,
+		}
+		return setmetatable(sym, mt)
+	end
+
+types.Number = tonumber
+
+types.String =
+	function (str)
+		local s = {
+			value = str,
+			escape =
+				function(self)
+					return self:gsub("\"", "\\\"")
+				end,
+		}
+		local mt = {
+			__type = "String",
+			__tostring =
+				function (self)
+					return string.format(
+						"\"%s\"",
+						self:escape())
+				end,
+		}
+		return setmetatable(s, mt)
+	end
+
+types.Cons =
+	function (a, b)
+		assert(a ~= nil and b ~= nil,
+			"Need two non-nil arguments in a pair")
+		local s = { a, b }
+		local mt = {
+			__type = "Pair",
+			__tostring =
+				function (p)
+					local out = {}
+					local car, cdr = p[1], p[2]
+					while cdr do
+						table.insert(out, tostring(car))
+						if type(cdr) == "table" then
+							car = cdr[1]
+							cdr = cdr[2]
+						else
+							table.insert(out, ".")
+							table.insert(out, cdr)
+							break
+						end
+					end
+					return "("..table.concat(out, " ")..")"
+				end
+
+		}
+		return setmetatable(s, mt)
 	end
-end
 
-types["number?"] = function (x) return types.lamtype(x) == "number" end
-types["symbol?"] = function (x) return types.lamtype(x) == "symbol" end
-types["list?"] = function (x) return types.lamtype(x) == "list" end
-types["procedure?"] = function (x) return types.lamtype(x) == "procedure" end
-types["null?"] = function (x) return x == {} end
+types.List =
+	function (tbl)
+		local function tolist(base, items)
+			if #items == 0 then return base end
+			return tolist(
+				types.Cons(table.remove(items), base),
+				items)
+		end
+		return tolist({}, tbl)
+	end
+
+--- Determining types
+
+types.lamtype =
+	function (x)
+		if type(x) == "number" then
+			return "Number"
+		elseif getmetatable(x) and getmetatable(x).__type then
+			return getmetatable(x).__type
+		else
+			return type(x)
+		end
+	end
+
+--- Type predicates
+
+types.isa =
+	function (x, t)
+		return types.lamtype(x) == t
+	end
 
 ---
 return types
diff --git a/util.lua b/util.lua
index 98536a1..1059edf 100644
--- a/util.lua
+++ b/util.lua
@@ -1,6 +1,7 @@
 --- lam.util
 
 local util = {}
+table.unpack = table.unpack or unpack
 
 function util.table (x)
 	if type(x) == "table" then
-- 
cgit 1.4.1-21-gabe81