From 8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 9 Apr 2024 21:04:17 -0500
Subject: Reorganization

---
 Makefile         |  19 ++-
 Organization.txt |   8 ++
 core.lua         | 241 ++++++++++++++++++-----------------
 dump.lua         |  39 +++---
 eval.lua         | 171 +++++++++----------------
 load.lua         |  68 ++++++++++
 port.lua         | 103 +++++++++++++++
 read.lua         | 380 +++++++++++++++++++++++--------------------------------
 repl.lua         |  81 +-----------
 type.lua         | 291 +++++++++++++++++++++++++++---------------
 util.lua         |  35 +++--
 11 files changed, 767 insertions(+), 669 deletions(-)
 create mode 100644 Organization.txt
 create mode 100644 load.lua
 create mode 100644 port.lua

diff --git a/Makefile b/Makefile
index 3495163..23d342f 100644
--- a/Makefile
+++ b/Makefile
@@ -1,25 +1,22 @@
 LUA ?= rlwrap luajit \
-	-e 'pp = require("dump").pp' \
+	-e 'core = require "core"' \
+	-e 'dump = require "dump"' \
 	-e 'eval = require "eval"' \
+	-e 'load = require "load"' \
+	-e 'port = require "port"' \
 	-e 'read = require "read"' \
+	-e 'repl = require "repl"' \
 	-e 'type = require "type"' \
-	-e 'utf8 = require "utf8"' \
-	-e 'util = require "util"' \
-	-e 'test = require "test"' \
-	-e 'repl = require "repl"'
+	-e 'util = require "util"'
 
 .PHONY: luarepl
 luarepl:
 	$(LUA) -i
 
-.PHONY: repl
-repl:
+.PHONY: lamrepl
+lamrepl:
 	$(LUA) -e 'require("repl").repl("> ")'
 
-.PHONY: test
-test:
-	$(LUA) -e 'test.runtests()'
-
 .PHONY: check
 check:
 	luacheck *.lua
diff --git a/Organization.txt b/Organization.txt
new file mode 100644
index 0000000..b2872d5
--- /dev/null
+++ b/Organization.txt
@@ -0,0 +1,8 @@
+
+utf8  type---.
+  |   /  \    \
+  read   eval  core(environment)
+      \  /     |
+      load<----'
+       |  (require "core"; core.env.load = m.load) ~ and other stuf i spose
+      repl
diff --git a/core.lua b/core.lua
index fd78997..20c6b5c 100644
--- a/core.lua
+++ b/core.lua
@@ -1,131 +1,138 @@
 --- lam.core --- core procedures
 
-local m = {}
-local type = require "type"
-local isa, null = type.isa, type.null
-local math = math
-local dump = require("dump").dump
--- local load = require("repl").load -- circular dependency :<
-local util = require "util"
-local assert_arity = util.assert_arity
+local dump = require("dump")
+local type = require("type")
+local null = type.null
+local assert_arity = type.assert_arity
 
 local function fold (kons, knil, r)
 	if r == null then
 		return knil
 	else
 		local step, early_return = kons(r[1], knil)
-		if early_return then return step end
+		if early_return then return early_return end
 		return fold(kons, step, r[2])
 	end
 end
 
-m.env = { -- all functions here take R, which is the list of arguments
-	------- equivalence
-	["eqv?"] =
-		function (r)
-			assert_arity(r, 2, 2)
-			return r[1] == r[2][1]
-		end,
-	["eq?"] =
-		function (r)
-			assert_arity(r, 2, 2)
-			-- from how i understand the Scheme spec, it's okay to
-			-- make `eqv?' and `eq?' the same.
-			return r[1] == r[2][1]
-		end,
-	-- equal? can be done in-library
-	------- i/o
-	display =
-		function (r)
-			assert_arity(r, 1, 1)
-			io.write(tostring(r[1]))
-		end,
-	newline =
-		function (r)
-			assert_arity(r, 0, 0)
-			io.write("\n")
-		end,
-	dump =
-		function (r)
-			assert_arity(r, 1, 1)
-			return dump(r[1])
-		end,
-	--[[	load = -- circular dependency :<
-		function (r)
-		assert_arity(r, 1, 1)
-		load(r[1])
-		end,
-	--]]
-	------- numbers
-	-- todo: assert all of these are numbers
-	["number?"] =
-		function (r)
-			assert_arity(r, 1, 1)
-			return isa(r[1], "number")
-		end,
-	["="] =
-		function (r)
-			if r[1] == nil then return true end
-			if r[2] == nil then return true end
-			while r[2] ~= null do
-				if r[1] ~= r[2][1] then return false end
-				r = r[2]
-			end
-			return true
-		end,
-	["<"] =
-		function (r)
-			if r[1] == nil then return true end
-			if r[2] == nil then return true end
-			while r[2] ~= null do
-				if r[1] >= r[2][1] then return false end
-				r = r[2]
-			end
-			return true
-		end,
-	[">"] =
-		function (r)
-			if r[1] == nil then return true end
-			if r[2] == nil then return true end
-			while r[2] ~= null do
-				if r[1] <= r[2][1] then return false end
-				r = r[2]
-			end
-			return true
-		end,
-	["<="] = function (r) return not m.env[">"](r) end,
-	[">="] = function (r) return not m.env["<"](r) end,
-	------- math
-	["+"] =
-		function (r)
-			return fold(function (a, b) return a + b end, 0, r)
-		end,
-	["-"] =
-		function (r)
-			if r == null then return -1 end
-			if r[2] == null then return (- r[1]) end
-			return fold(function (a, b)
-					return a - b
-			end, r[1], r[2])
-		end,
-	["*"] =
-		function (r)
-			local function go (a, b)
-				if a == 0 or b == 0 then
-					return 0, 1
-				end
-				return a * b
-			end
-			return fold(go, 1, r)
-		end,
-	["/"] =
-		function (r)
-			assert_arity(r, 1)
-			if r[2] == null then return (1 / r[1]) end
-			return fold(function (a, b) return a / b end,
-				r[1], r[2])
-		end,
-}
+local env = {}
+
+---[[ EQUIVALENCE ]]---
+
+env["eqv?"] = function (r)
+	assert_arity(r,2,2)
+	return r[1] == r[2][1]
+end
+-- from what i understand of the spec, it's okay that eqv? and eq? are the same
+env["eq?"] = env["eqv?"]
+
+---[[ TYPES ]]---
+
+env["boolean?"] = function (r)
+	assert_arity(r,1,1)
+	return r[1] == false or r[1] == true
+end
+
+env["port?"] = function (r)
+	assert_arity(r,1,1)
+	return type.isp(r[1], "input-port") or type.isp(r[1], "output-port")
+end
+
+for _, t in ipairs {
+	"symbol",
+	-- todo: vector
+	"procedure",
+	"pair",
+	"number",
+	"string",
+	"port",
+} do
+	env[t.."?"] = function (r)
+		assert_arity(r,1,1)
+		return type.isp(r[1], t)
+	end
+end
+
+---[[ NUMBERS ]]---
+
+env["="] = function (r)
+	if r[1] == nil then return true end
+	if r[2] == nil then return true end
+	while r[2] ~= null do
+		if r[1] ~= r[2][1] then return false end
+		r = r[2]
+	end
+	return true
+end
+
+env["<"] = function (r)
+	if r[1] == nil then return true end
+	if r[2] == nil then return true end
+	while r[2] ~= null do
+		if r[1] >= r[2][1] then return false end
+		r = r[2]
+	end
+	return true
+end
+env[">"] = function (r)
+	if r[1] == nil then return true end
+	if r[2] == nil then return true end
+	while r[2] ~= null do
+		if r[1] <= r[2][1] then return false end
+		r = r[2]
+	end
+	return true
+end
+env["<="] = function (r) return not env[">"](r) end
+env[">="] = function (r) return not env["<"](r) end
+
+env["+"] = function (r)
+	return fold(function (a, b) return a + b end, 0, r)
+end
+
+env["-"] = function (r)
+	if r == null then return -1 end
+	if r[2] == null then return (- r[1]) end
+	return fold(function (a, b)
+			return a - b
+	end, r[1], r[2])
+end
+
+env["*"] = function (r)
+	local function go (a, b)
+		if a == 0 or b == 0 then
+			return 0, 1
+		end
+		return a * b
+	end
+	return fold(go, 1, r)
+end
+
+env["/"] = function (r)
+	assert_arity(r,1)
+	if r[2] == null then return (1 / r[1]) end
+	return fold(function (a, b) return a / b end,
+		r[1], r[2])
+end
+
+---[[ INPUT / OUTPUT ]]---
+
+env.dump = function (r)
+	assert_arity(r,1,1)
+	return dump.dump(r[1])
+end
+
+env.display = function (r)
+	assert_arity(r,1,1)
+	io.write(r[1])
+end
+
+env.newline = function (r)
+	assert_arity(r,0,0)
+	io.write("\n")
+end
 
 --------
-return m
+return {
+	environment = env,
+}
diff --git a/dump.lua b/dump.lua
index dc32096..538f606 100644
--- a/dump.lua
+++ b/dump.lua
@@ -1,36 +1,33 @@
---- lam.pp
+--- lam.dump --- dump raw lua values
 
 local m = {}
-local type = require "type"
+local type = require("type")
 
 function m.dump (x, lvl)
 	lvl = lvl or 0
-	local space = string.rep(" ", lvl)
-	local output = ""
-	--[[if getmetatable(x) and getmetatable(x).__tostring then
-		output = output .. tostring(x)
-		else]]if type.luatype(x) == "table" then
-		local subo = ""
-		for k,v in pairs(x) do
+	local space = string.rep(" ", lvl*4)
+	local out = {}
+	if type.luatype(x) == "table" then
+		local sub = {}
+		for k, v in pairs(x) do
 			if v == x then
 				v = "self"
+			elseif type.lamtype(v) == "environment" then
+				v = tostring(v)
 			else
-				v = m.dump(v, lvl+2)
+				v = m.dump(v, lvl+1)
 			end
-			subo = subo .. string.format("\n%s[%s] = %s,",
-				(space.."  "), k, v)
+			table.insert(sub,
+				string.format("\n%s[%s] = %s,", space, k, v))
 		end
-		output = output .. string.format("\n%s{%s\n%s}",
-			space, subo, space)
+		table.insert(out,
+			string.format("\n%s{%s\n%s}",
+				space, table.concat(sub), space))
 	else
-		output = output .. tostring(x)
+		table.insert(out, tostring(x))
 	end
-	return output
+	return table.concat(out)
 end
 
-function m.pp (x)
-	print(m.dump(x))
-end
-
----
+--------
 return m
diff --git a/eval.lua b/eval.lua
index 867a704..4b8f782 100644
--- a/eval.lua
+++ b/eval.lua
@@ -1,150 +1,97 @@
 --- lam.eval
 
 local m = {}
-local type = require "type"
-local assert_arity = require("util").assert_arity
+local type = require("type")
+local assert_arity = type.assert_arity
+local util = require("util")
+local error = util.error
 
-function m.environ (inner, outer)
-	local mt = {
-		__type = "environment",
-		__index = outer,
-		__newindex =
-			function (self, key, val)
-				if rawget(self, key) then
-					rawset(self, key, val)
+m.special_forms = {
+	quote =
+		function (r, _)
+			assert_arity(r,1,1)
+			return r[1]
+		end,
+	quasiquote =
+		function (r, e)
+			assert_arity(r,1,1)
+			local x = r[1]
+			if not type.listp(x) or type.nullp(x) then
+				return x
+			end
+			local QQ, fin = {}, nil
+			while x[2] do
+				if type.listp(x[1]) then
+					if x[1][1] == "unquote" then
+						table.insert(QQ,
+							m.eval(x[1][2][1], e))
+					elseif x[1][1] == "unquote-splicing"
+					then
+						local y = m.eval(x[1][2][1], e)
+						if not type.listp(y) then
+							fin = y
+							break
+						end
+						while y[2] do
+							table.insert(QQ, y[1])
+							y = y[2]
+						end
+					end
 				else
-					getmetatable(self).__index[key] = val
-				end
-			end,
-	}
-	return setmetatable(inner, mt)
-end
-
-local function procedure_call (proc, r)
-	local function doargs (p, r, e)
-		if p == type.null and r == type.null then return e end
-		if type.isa(p, "symbol") then
-			e[p] = r
-			return e
-		end
-		if p[1] == nil then error("Too many arguments") end
-		if r[1] == nil then error("Too few arguments") end
-		e[p[1]] = r[1]
-		doargs(p[2], r[2], e)
-	end
-
-	local e = doargs(proc.params, r, m.environ({}, proc.env))
-	local b = proc.body
-	while b[2] ~= type.null do
-		m.eval(b[1], e)
-		b = b[2]
-	end
-	return m.eval(b[1], e)
-end
-
-function m.procedure (params, body, env)
-	local t = {
-		params = params,
-		body = body,
-		env = env,
-	}
-	local mt = {
-		__type = "procedure",
-		__call = procedure_call,
-	}
-	return setmetatable(t, mt)
-end
-
-local function handle_quasiquote (r, e)
-	assert_arity(r, 1, 1)
-	local x = r[1]
-	if not type.islist(x) or x == type.null then
-		return x
-	end
-	local QQ, fin = {}, nil
-	local car, cdr = x[1], x[2]
-	while cdr do
-		if type.islist(car) then
-			if car[1] == "unquote" then
-				table.insert(QQ, m.eval(car[2][1], e))
-			elseif car[1] == "unquote-splicing" then
-				local usl = m.eval(car[2][1], e)
-				if not type.islist(usl) then
-					fin = usl
-					break
-				end
-				while usl[2] do
-					table.insert(QQ, usl[1])
-					usl = usl[2]
+					table.insert(QQ, x[1])
 				end
+				x = x[2]
 			end
-		else
-			table.insert(QQ, car)
-		end
-		car, cdr = cdr[1], cdr[2]
-	end
-	return type.list(QQ, fin)
-end
-
-m.specials = {
-	-- each of these takes R (a list of args) and E (an environment)
-	quote =
-		function (r, e)
-			assert_arity(r, 1, 1)
-			return r[1]
+			return type.list(QQ, fin)
+		end,
+	unquote =
+		function (_, _)
+			error("unexpected", ",")
 		end,
-	quasiquote = handle_quasiquote,
-	-- if not inside quasiquote, unquote and unquote-splicing are errors
-	unquote = function () error("Unexpected unquote") end,
 	["unquote-splicing"] =
-		function () error("Unexpected unquote-splicing") end,
-	-- define variables
+		function (_, _)
+			error("unexpected", ",@")
+		end,
 	define =
 		function (r, e)
-			assert_arity(r, 2, 2)
+			assert_arity(r,2,2)
 			rawset(e, r[1], m.eval(r[2][1], e))
 		end,
 	["set!"] =
 		function (r, e)
-			assert_arity(r, 2, 2)
+			assert_arity(r,2,2)
 			e[r[1]] = m.eval(r[2][1], e)
 		end,
-	-- y'know, ... lambda
 	lambda =
 		function (r, e)
-			assert_arity(r, 2)
-			return m.procedure(r[1], r[2], e)
+			assert_arity(r,2)
+			return type.procedure(r[1], r[2], e, m.eval)
 		end,
-	-- control flow
 	["if"] =
 		function (r, e)
-			assert_arity(r, 3, 3)
-			local test, conseq, alt =
-				r[1], r[2][1], r[2][2][1]
+			assert_arity(r,3,3)
+			local test, conseq, alt = r[1], r[2][1], r[2][2][1]
 			if m.eval(test, e)
 			then return m.eval(conseq, e)
 			else return m.eval(alt, e)
 			end
 		end,
-	-- TODO: include, import, define-syntax, ...
+	-- TODO: include, import, define-syntax ...
 }
--- Aliases
-m.specials.lam = m.specials.lambda
-m.specials.def = m.specials.define
 
-function m.eval (x, env) -- TODO: specify ENV on all calls
-	if type.isa(x, "symbol") then
+function m.eval (x, env)
+	if type.isp(x, "symbol") then
 		if env[x] == nil then
-			error(string.format("Unbound variable: %s", x))
+			error("unbound symbol", x)
 		end
 		return env[x]
-	elseif not type.islist(x) then
+	elseif not type.listp(x) then
 		return x
 	else
 		local op, args = x[1], x[2]
-		if m.specials[op] then
-			return m.specials[op](args, env)
-		else		-- procedure call
+		if m.special_forms[op] then
+			return m.special_forms[op](args, env)
+		else -- procedure application
 			local fn = m.eval(op, env)
 			local params = {}
 			local r = args
diff --git a/load.lua b/load.lua
new file mode 100644
index 0000000..f798712
--- /dev/null
+++ b/load.lua
@@ -0,0 +1,68 @@
+--- lam.load
+
+local m = {}
+local core = require("core")
+local eval = require("eval")
+local port = require("port")
+local read = require("read")
+local type = require("type")
+
+local function schemeprint (x)
+	-- possibly a candidate to put in a `write' library
+	if x == true then print("#t")
+	elseif x == false then print("#f")
+	elseif x == nil then return -- print("#<nil>")
+	else print(x)
+	end
+end
+
+local function handle_error (e)
+	local start = e:find(": ")
+	return e:sub(start + 2)
+end
+
+function m.load (filename, interactive)
+	-- interactive = { out = file/handle, prompt = string, }
+	local inport = port.input_port(filename)
+	if interactive then
+		io.output(interactive.out)
+		io.output():setvbuf("line")
+	else
+		io.output():setvbuf("no")
+	end
+	repeat
+		if interactive then
+			io.stderr:write(interactive.prompt or "")
+			io.stderr:flush()
+		end
+		-- read
+		local read_ok, form = xpcall(
+			function () return read.read(inport) end,
+			handle_error)
+		if form == port.eof then break end
+		if not read_ok then
+			io.stderr:write("error (read): ", form, "\n")
+			-- when interactive, errors should not be fatal, but
+			-- they should be in batch mode
+			inport:flush() -- avoid endless loop
+			if not interactive then return nil end
+		else
+			-- eval
+			local eval_ok, value = xpcall(
+				function ()
+					return eval.eval(form, core.environment)
+				end,
+				handle_error)
+			if not eval_ok then
+				io.stderr:write("error (eval): ", value, "\n")
+				if not interactive then return nil end
+			else
+				-- print
+				if interactive then schemeprint(value) end
+			end
+		end
+	until value == port.eof -- loop
+end
+
+--------
+return m
diff --git a/port.lua b/port.lua
new file mode 100644
index 0000000..812f05e
--- /dev/null
+++ b/port.lua
@@ -0,0 +1,103 @@
+--- lam.port --- port objects
+-- because the implementation for ports is fairly involved, they're in their own
+-- file outside of `type'.
+
+local m = {}
+local util = require("util")
+local error = util.error
+local tochars = util.tochars
+
+-- The EOF object is what the reader emits when it hits an end-of-file or use up
+-- a port.
+m.eof = setmetatable({}, {
+		__type = "eof",
+		__tostring = function () return "#<eof>" end,
+})
+
+---[[ INPUT PORTS ]]---
+
+-- return the next token from PORT, given READTABLE
+local function input_port_next_token (port, readtable)
+	repeat
+		if #port.buffer == 0 then
+			if port.file then
+				local ln = port.file:read()
+				if ln == nil then
+					return m.eof
+				end
+				port.buffer = tochars(ln)
+			else
+				return m.eof
+			end
+		end
+
+		local token, token_type
+		local c = port.buffer[1]
+		if readtable.chars[c] then
+			token, token_type, port.buffer =
+				readtable.chars[c](port.buffer)
+		else
+			for re, fn in pairs(readtable.regex) do
+				if c:match(re) then
+					token, token_type, port.buffer =
+						fn(port.buffer)
+					break
+				end
+			end
+			if token == nil then
+				token, token_type, port.buffer =
+					readtable.default(port.buffer)
+			end
+		end
+
+		port.buffer = port.buffer or {}
+		if token then
+			return token, token_type
+		end
+	until nil
+end
+
+function m.input_port (source, source_type)
+	-- SOURCE is the name of the file/string to read or nil; nil means
+	-- standard input.  SOURCE_TYPE is one of "file", "string"; "file" is
+	-- the default.
+	local f, b
+	source_type = source_type or "file"
+	if source then
+		if source_type == "file" then
+			f = io.open(source, "r")
+		elseif source_type == "string" then
+			b = tochars(source)
+		else
+			error("input-port: bad type", source_type)
+		end
+	else
+		f = io.input() -- ignore SOURCE_TYPE
+	end
+	local t = {
+		file = f,
+		name = f and source or "[string]",
+		type = source_type,
+		buffer = b or {},
+		flush = function (self) self.buffer = {} end,
+		next = input_port_next_token, -- port:next(readtable)
+		close =
+			function (self)
+				if self.file then self.file:close() end
+			end,
+	}
+	local mt = {
+		__type = "input-port",
+		__tostring =
+			function (self)
+				return string.format("#<port %s>", self.name)
+			end,
+	}
+	return setmetatable(t, mt)
+end
+
+---[[ OUTPUT PORTS ]]---
+-- TODO
+
+--------
+return m
diff --git a/read.lua b/read.lua
index 332c919..6d55e23 100644
--- a/read.lua
+++ b/read.lua
@@ -1,166 +1,29 @@
 --- lam.read
 
 local m = {}
-local t = require "type"
-local utf8 = require "utf8"
-local pop = require("util").pop
+local type = require("type")
+local port = require("port")
+local eof, input_port = port.eof, port.input_port
+local util = require("util")
+local constantly, error, pop = util.constantly, util.error, util.pop
 
--- TODO:
--- - string reading
--- - probably more
-
-m.eof = setmetatable({}, {
-		__type = "EOF",
-		__tostring = function () return "#<eof>" end,
-})
-
-local function inport_next_token (port)
-	local tok, toktype
-	while true do
-		if #port.line == 0 then
-			if port.file then
-				local ln = port.file:read()
-				if ln == nil then return m.eof end
-				port.line = m.tochars(ln)
-			else
-				return nil
-			end
-		end
-		tok, toktype, port.line = m.scan(port.line)()
-		port.line = port.line or {}
-		if tok ~= nil then return tok, toktype end
-	end
-end
-
-function m.inport (source, kind)
-	-- KIND can be one of "file", "string"; defaults to "file"
-	-- SOURCE is the name of the file or the string to read, or nil; if nil,
-	-- read from standard input.
-	local f, l
-	local k = kind or "file"
-	if source then
-		if k == "file" then
-			f = io.open(source, "r")
-		elseif k == "string" then
-			l = m.tochars(source)
-		end
-	else
-		-- KIND is ignored here
-		f = io.input()
-	end
-	local t = {
-		file = f,
-		filename = source,
-		kind = kind,
-		line = l or {},
-		next_token = inport_next_token,
-	}
-	if t.file then t.close = function (self) self.file:close() end; end
-	local mt = {
-		__type = "port",
-		__tostring =
-			function (self)
-				return string.format("#<port %s>",
-					self.file or "(string)")
-			end,
-	}
-	return setmetatable(t, mt)
-end
-
-function m.tochars (s)
-	local chars = {}
-	for _, code in utf8.codes(s) do
-		table.insert(chars, code)
-	end
-	return chars
-end
-
---- Consumers
--- These take a table of characters (cs) and return:
--- a token, its type, and the rest of the characters
-
-local token_separator = "[^%s#()\"'`,@;]"
+local token_separators = "[%s#()\"'`,@;]"
 
 local function consume_token (cs)
-	local token = {}
-	while #cs > 0 and cs[1]:match(token_separator) do
-		table.insert(token, pop(cs))
+	local tok = {}
+	while #cs > 0 and not cs[1]:match(token_separators) do
+		local c = pop(cs)
+		table.insert(tok, c)
 	end
-	return table.concat(token), "symbol", cs
+	return table.concat(tok), cs
 end
 
-local function consume_whitespace (cs)
-	while #cs > 0 and cs[1]:match("%s") do pop(cs) end
-	return nil, nil, cs
-end
-
-local function consume_comment (cs)
-	local comment = {}
-	repeat table.insert(comment, pop(cs))
-	until #cs == 0 or cs[1]:match("\n")
-	return table.concat(comment), "comment", cs
-end
-
-local function idf (x)
-	return function () return x end
-end
-
-local function numf (base)
-	return function (token)
-		local n = tonumber(token:sub(3), base)
-		assert(n, "Can't read number: " .. token)
-		return n
-	end
-end
-
-local literals = {
-	literal = {
-		["#t"] = idf(true),
-		["#true"] = idf(true),
-		["#f"] = idf(false),
-		["#false"] = idf(false),
-		["#\\space"] = idf(t.character(" ")),
-		["#\\tab"] = idf(t.character("\t")),
-		["#\\newline"] = idf(t.character("\n")),
-	},
-	match = {
-		["^#b"] = numf(2),
-		["^#o"] = numf(8),
-		["^#d"] = numf(10),
-		["^#x"] = numf(16),
-		["^#\\"] = function (tok) return t.character(tok:sub(3)) end,
-	}
-}
-
-local function consume_literal (cs)
-	-- whitespace and parantheses character literals.
-	-- reverse the match test b/c it's already a complement
-	if cs[2] == "\\" and not cs[3]:match(token_separator) then
-		return type.character(cs[3])
-	end
-	pop(cs) -- discard '#'
-	local token, value, cs = consume_token(cs) -- todo: vectors #(...)
-	token = "#" .. token -- put '#' back
-
-	if literals.literal[token] then
-		value = literals.literal[token]()
-	else
-		for re, fn in pairs(literals.match) do
-			if token:match(re) then
-				value = fn(token)
-			end
-		end
-	end
-	-- TODO : if `nil' is to be a value in lam i'm going to have to figure
-	-- out some kind of 'lam nil' and 'lua nil' or something..
-	assert(value~=nil, "Can't read literal: " .. token)
-
-	return value, "literal", cs
-end
+---[[ READ TABLE ]]---
 
---- Reading from a port
-
-m.readtable = {
+-- each function should take a list of characters and return the token, its
+-- type, and the rest of the characters
+m.readtable = {}
+m.readtable.chars = {
 	["("] = function (cs) return pop(cs), "open", cs end,
 	[")"] = function (cs) return pop(cs), "close", cs end,
 	["'"] = function (cs) return pop(cs), "quote", cs end,
@@ -175,109 +38,184 @@ m.readtable = {
 				return ",", "quote", cs
 			end
 		end,
-	[";"] = consume_comment,
-	["#"] = consume_literal,
-}
+	[";"] = -- comment
+		function (cs)
+			local comment = {}
+			while #cs > 0 and not cs[1]:match("\n") do
+				table.insert(comment, pop(cs))
+			end
+			return table.concat(comment), "comment", cs
+		end,
+	["#"] = -- literal
+		function (cs)
+			local tok
+			-- bail on just '#\'
+			if not (cs[2] and cs[3]) then
+				cs = {}
+				error("bad literal", "#\\")
+			end
 
---- TODO: Figure out how to read #f and #n properly
+			-- read '#\ ' and such correctly
+			if cs[2] == "\\" and cs[3]:match(token_separators) then
+				pop(cs) -- remove '\'
+				pop(cs) -- remove next character
+				return type.character(cs[1])
+			end
 
--- Return an iterator over a character table, so you can do:
--- for token, chars in scan(cs) do ... end
-function m.scan (cs)
-	local cs = cs
-	return function ()
-		if not next(cs) then return nil end
-		local token, toktype
-		while true do
-			if m.readtable[cs[1]] then
-				token, toktype, cs = m.readtable[cs[1]](cs)
-				return token, toktype, cs
-			elseif cs[1]:match("%s") then
-				--- should this just continue the loop?
-				-- i.e., remove `return'
-				return consume_whitespace(cs)
-			elseif cs[1]:match("[%d.+-]") then
-				-- numbers, +, -, ., ...
-				local token, _, cs = consume_token(cs)
-				if token:match("[-+]") or token == "..." then
-					return token, "symbol", cs
-				elseif token == "." then
-					return token, "dot", cs
-				else
-					local n = tonumber(token)
-					assert (n ~= nil, "Bad number: "..n)
-					return n, "number", cs
-				end
+			pop(cs) -- discard '#' ...
+			tok, cs = consume_token(cs)
+			tok = "#" .. tok -- ... then put it back
+
+			local val
+			if m.readtable.literals.lit[tok] then
+				val = m.readtable.literals.lit[tok]
 			else
-				return consume_token(cs)
+				for re, fn in pairs(m.readtable.literals.regex)
+				do
+					if tok:match(re) then
+						val = fn(tok)
+					end
+				end
+			end
+
+			if val == nil then
+				error("bad literal", tok)
+			end
+			return val, "literal", cs
+		end,
+}
+m.readtable.regex = {
+	["%s"] = -- whitespace
+		function (cs)
+			while #cs > 0 and cs[1]:match("%s") do
+				pop(cs)
+			end
+			return false, nil, cs
+		end,
+	["[%d.+-]"] = -- numbers and symbols +, -, ., and ...
+		function (cs)
+			local tok
+			tok, cs = consume_token(cs)
+			if tok:match("^[-+]$") or tok == "..." then
+				return tok, "symbol", cs
+			elseif tok == "." then
+				return tok, "dot", cs
+			else -- number
+				local n = tonumber(tok)
+				if not n then
+					error("bad number", n)
+				end
+				return n, "number", cs
 			end
+		end,
+}
+m.readtable.default = -- default action if nothing else matches
+	function (cs)
+		local tok, cs = consume_token(cs)
+		return tok, "symbol", cs
+	end
+
+-- convenience function to make writing the regexen rules easier below
+local function based_num (base)
+	return function (token)
+		local n = tonumber(token:sub(3), base)
+		if not n then
+			error("bad number", token)
 		end
+		return n
 	end
 end
 
-function m.readchar (port)
-	if #port.line > 0 then
-		local ch = pop(port.line)
-		return ch
-	else
-		return port.file and port.file.read(1)
-	end
+m.readtable.literals = {
+	lit = {
+		["#t"] = true,
+		["#true"] = true,
+		["#f"] = false,
+		["#false"] = false,
+	},
+	regex = {
+		["^#b"] = based_num(2),
+		["^#o"] = based_num(8),
+		["^#d"] = based_num(10),
+		["^#x"] = based_num(16),
+		["^#\\."] =
+			function (tok)
+				return type.character(tok:sub(3))
+			end,
+	},
+}
+-- add named characters
+for char, name in pairs(type.character_names) do
+	m.readtable.literals.lit["#\\"..name] = type.character(char)
 end
 
+---[[ READER MACROS ]]---
+-- Each of these are named after the type of the token read and contain
+-- function taking (TOKEN, TYPE, PORT) and returning a lisp object
+
 m.readmacros = {
+	close =
+		function (token, _, _)
+			error("unexpected", token)
+		end,
 	quote =
-		function (tok, toktype, port)
+		function (token, _, port)
 			local qs = {
 				["'"] = "quote",
 				["`"] = "quasiquote",
 				[","] = "unquote",
 				[",@"] = "unquote-splicing",
 			}
-			if not qs[tok] then
-				error(string.format("Bad quote: '%s'\n", tok))
+			if not qs[token] then
+				error("bad quote", token)
 			end
-			local Q = {qs[tok]}
+			local Q = {qs[token]}
 			table.insert(Q, m.read(port))
-			return t.list(Q)
+			return type.list(Q)
 		end,
-	comment = idf(nil)
+	comment = constantly(nil), -- throw comments away
 }
 
+---[[ READ ]]---
+
 function m.read (port)
-	local function read_ahead (tok, toktype)
-		if tok == m.eof then error("Unexpected EOF") end
-		if toktype == "open" then
+	local function read_ahead(token, token_type)
+		if token == eof then error("unexpected", token) end
+		if token_type == "open" then
+			-- this must be defined here because it calls read_ahead
+			-- recursively.
 			local L = {}
-			while true do
-				local tok, toktype = port:next_token()
-				if toktype == "close" then
-					return t.list(L)
-				elseif toktype == "dot" then
+			repeat
+				token, token_type = port:next(m.readtable)
+				if token_type == "close" then
+					return type.list(L)
+				elseif token_type == "dot" then
 					local fin = m.read(port)
-					port:next_token() -- throw away ')'
-					return t.list(L, fin)
+					port:next(m.readtable) -- discard ')'
+					return type.list(L, fin)
 				else
 					table.insert(L,
-						read_ahead(tok, toktype))
+						read_ahead(token, token_type))
 				end
-			end
-		elseif toktype == "close" then
-			error("Unexpected ')'")
-		elseif m.readmacros[toktype] then
-			return m.readmacros[toktype](tok, toktype, port)
-		else return tok
+			until nil
+		elseif m.readmacros[token_type] then
+			return m.readmacros[token_type](token, token_type, port)
+		else
+			return token
 		end
 	end
-	-- body of read
-	local tok1, toktype1 = port:next_token()
-	if tok1 == m.eof then return m.eof
-	else return read_ahead(tok1, toktype1)
+	---
+	local token1, type1 = port:next(m.readtable)
+	if token1 == eof then
+		return eof
+	else
+		return read_ahead(token1, type1)
 	end
 end
 
 function m.read_string (str)
-	return m.read(m.inport(str, "string"))
+	return m.read(input_port(str, "string"))
 end
 
----
+--------
 return m
diff --git a/repl.lua b/repl.lua
index c4a6546..4bdd918 100644
--- a/repl.lua
+++ b/repl.lua
@@ -1,25 +1,9 @@
 --- lam.repl
 
 local m = {}
-local _r = require("read")
-local read, inport, read_string, eof =
-	_r.read, _r.inport, _r.read_string, _r.eof
-local eval = require("eval").eval
+local load = require("load").load
 
-local function schemeprint (x)
-	-- if x == nil then return end
-	if x == true then
-		print("#t")
-	elseif x == false then
-		print("#f")
-	elseif x == nil then
-		print("#<nil>")
-	else
-		print(x)
-	end
-end
-
-local lam = [[
+m.logo = [[
  @,,,@
 <|^ ^|>  l a m
  |   /)   0015
@@ -27,66 +11,9 @@ local lam = [[
  -------------
 ]]
 
-local function handle_error (e)
-	local start = e:find(": ")
-	return e:sub(start + 2)
-end
-
-function m.read_eval (filename, interactive)
-	-- interactive = { out = file or handle, prompt = string, }
-	local inport = inport(filename)
-	local prompt = interactive and interactive.prompt or "> "
-	if interactive then
-		io.output(interactive.out or io.stdout)
-		io.write(lam)
-		io.output():setvbuf("line")
-	else
-		io.output():setvbuf("no")
-	end
-	repeat
-		if interactive then
-			io.stderr:write(prompt)
-			io.stderr:flush()
-		end
-		-- read
-		local ok, x = xpcall(
-			function ()
-				local nxt = read(inport)
-				return nxt
-			end,
-			handle_error
-		)
-		if not ok then
-			io.stderr:write("(read) not ok: ", x, "\n")
-			-- in interactive mode, errors should not be fatal.  in
-			-- batch mode, they should be.
-			if not interactive then return nil end
-		end
-		-- eval
-		if ok then
-			local ok, v = xpcall(
-				function () return eval(x) end,
-				handle_error
-			)
-			if not ok then
-				io.stderr:write("(eval) not ok: ", v, "\n")
-				if not interactive then return nil end
-			end
-			-- print
-			if ok and interactive then schemeprint(v) end
-		elseif interactive then
-			ok = "recover"
-		end
-	until x == eof -- loop
-	inport:close()
-end
-
 function m.repl (prompt)
-	return m.read_eval(nil, { prompt = prompt, })
-end
-
-function m.load (filename)
-	return m.read_eval(filename)
+	io.stderr:write(m.logo)
+	return load(nil, {prompt = prompt or "> ", })
 end
 
 --------
diff --git a/type.lua b/type.lua
index f119270..c205468 100644
--- a/type.lua
+++ b/type.lua
@@ -1,112 +1,192 @@
 --- lam.type
+-- this library implements lam types---atomic and collection---and type
+-- predicates.  it also re-exports lua's `type` as type.luatype and implements
+-- `type.lamtype`.  types are implemented as functions to build the given type
+-- from some arguments.  their metatables contain various metamethods, but also
+-- `__type`.
 
 local m = {}
-local utf8 = require "utf8"
-utf_char, utf_codepoint = utf8.char, utf8.codepoint
+local utf8 = require("utf8")
+local util = require("util")
+local tochars, error, constantly = util.tochars, util.error, util.constantly
 
---- atomic types
+---[[ ATOMIC TYPES ]]---
 
--- true, false and nil are just ... true, false, and nil
+-- a lam symbol is a lua string
+m.symbol = tostring
+
+-- a lam number is a lua number
+-- TODO: implement full numeric tower
+m.number = tonumber
+
+-- a character is a wrapped single-character string
+-- it contains both the string representation and the character's codepoint
+
+m.character_names = {
+	-- some characters, like whitespace, have names
+	["\n"] = "newline",
+	[" "] = "space",
+	["\t"] = "tab",
+}
 
--- Characters contain both their string reputations and their codepoints
 function m.character (x)
-	-- is storing a character with its string and numerical representation
-	-- overkill?  ... maybe.
 	local s = tostring(x)
-	local uc = utf_codepoint(s)
-	local t = { -- String representation of the character
-		v = utf_char(uc),
+	local uc = utf8.codepoint(s)
+	local t = {
+		v = utf8.char(uc),
 		u = uc,
 	}
 	local mt = {
-		__type = "character",
-		__eq = function (self) return self.v end,
+		__type = "char", -- scheme name
+		-- compare using codepoints since they're just numbers
+		__eq = function (a, b) return a.u == b.u end,
 		__lt = function (a, b) return a.u < b.u end,
 		__tostring =
 			function (self)
 				local v = self.v
-				if v == "\n" then
-					return "#\\newline"
-				elseif v == " " then
-					return "#\\space"
-				else
-					return "#\\" .. v
+				if m.character_names[v] then
+					v = m.character_names[v]
 				end
+				return "#\\" .. v
 			end,
 	}
 	return setmetatable(t, mt)
 end
 
--- a symbol is just a string, unadorned.  I was going to have a character be
--- represented by a one-character string, but then it would be indistinguishable
--- from a one-character symbol internally.
-m.symbol = tostring
+---[[ PROCEEDURES AND ENVIRONMENTS ]]---
 
--- for now, number will just be lua's number.  At *some* point, it will be the
--- whole numeric tower, yaaayyy
-m.number = tonumber
+function m.environment (inner, outer)
+	local mt = {
+		__type = "environment",
+		__index = outer,
+		__newindex =
+			function (self, key, val)
+				if rawget(self, key) then
+					rawset(self, key, val)
+				else
+					getmetatable(self).__index[key] = val
+				end
+			end,
+		__tostring = constantly("#<environment>"),
+	}
+	return setmetatable(inner, mt)
+end
 
--- strings are wrapped strings
-function m.string (x)
-	local x = tostring(x)
+function m.procedure (params, body, env, eval)
 	local t = {
-		v = x,
-		escape =
-			function (self)
-				return self.v:gsub("[\\\"]", "\\%1")
-			end,
+		params = params,
+		body = body,
+		env = env,
+		eval = eval,
 	}
 	local mt = {
-		__type = "string",
+		__type = "procedure",
 		__tostring =
 			function (self)
-				return "\"" .. self:escape() .. "\""
+				return string.format("(lambda %s %s)",
+					params,
+					tostring(body):sub(2, -2))
+			end,
+		__call =
+			function (self, r)
+				local rlen = #r
+				local function doargs (p, r, e)
+					-- base case
+					if m.nullp(p) and m.nullp(r) then
+						return e
+					end
+					-- (lambda x ..) or (lambda (x . y) ..)
+					if type.isp(p, "symbol") then
+						e[p] = r
+						return e
+					end
+					if p[1] == nil then
+						error("too many arguments",
+							rlen, #self.params)
+					end
+					if r[1] == nil then
+						error("too few arguments",
+							rlen, #self.params)
+					end
+					-- bind car(p) to car(r)
+					e[p[1]] = r[1]
+					-- recurse
+					return doargs(p[2], r[2], e)
+				end
+				-- create new, expanded environment
+				e = doargs(self.params, r,
+					m.environment({}, self.env))
+				local b = self.body
+				-- evaluate body forms
+				while not m.nullp(b[2]) do
+					self.eval(b[1], e)
+					b = b[2]
+				end
+				-- return last body form
+				return self.eval(b[1], e)
 			end,
 	}
 	return setmetatable(t, mt)
 end
 
--- null () is both an atom and a list (yay)
--- this one is NOT a function
+function m.assert_arity (r, min, max)
+	local rmin = min or 0
+	local rmax = max or 1/0 -- infinity
+	local rlen = #r
+	if rlen < rmin or rlen > rmax then
+		error("wrong arity", rlen, m.cons(rmin, rmax))
+	end
+end
+
+---[[ NULL ]]---
+-- The empty list () is the only object that is both an atom and a list.  It
+-- forms the ultimate tail of every "proper" list.  The important thing is that
+-- it's its own object.
+
 m.null = setmetatable({}, {
 		__type = "null",
-		__tostring = function (self) return "()" end,
+		__tostring = function () return "()" end,
 })
 
---- collection types
+function m.nullp (x)
+	return x == m.null
+end
+
+---[[ COLLECTION TYPES ]]---
 
--- cons are lisp's fundamental collection type
+-- cons are lisp's fundamental collection type: they link two things together in
+-- a structure
 function m.cons (a, b)
 	local t = { a, b, }
 	local mt = {
-		__type = "cons",
+		__type = "pair", -- scheme name
 		__tostring =
 			function (self)
-				local out = {}
-				local car, cdr = self[1], self[2]
-				while cdr do
-					table.insert(out, tostring(car))
-					if m.luatype(cdr) == "table" then
-						car = cdr[1]
-						cdr = cdr[2]
+				local t, p = {}, self
+				while p[2] do
+					table.insert(t, tostring(p[1]))
+					if m.luatype(p[2]) == "table" then
+						p = p[2]
 					else
-						table.insert(out, ".")
-						table.insert(out, cdr)
+						table.insert(t, ".")
+						table.insert(t, p[2])
 						break
 					end
 				end
-				return "(" .. table.concat(out, " ") .. ")"
+				return string.format("(%s)",
+					table.concat(t, " "))
 			end,
 		__len =
 			function (self)
-				local function go (lis, acc)
+				local function go (x, acc)
 					-- improper lists don't have lengths
-					-- ... but don't error here.
-					if not m.isa(lis, "cons") then
+					if not m.isp(x, "pair") then
 						return nil
 					end
-					if lis[2] == m.null then return acc
-					else return go(lis[2], acc+1)
+					if m.nullp(x[2]) then
+						return acc
+					else
+						return go(x[2], acc + 1)
 					end
 				end
 				return go(self, 1)
@@ -115,74 +195,87 @@ function m.cons (a, b)
 	return setmetatable(t, mt)
 end
 
--- lists are singly-linked cons cells
-function m.list (items, last)
-	-- ITEMS is a table and LAST is an optional final cdr.  If it's nil, the
-	-- list is a "proper" list; that is, it ends in ().
+-- a series of cons cells linked together is a list
+function m.list (items, final)
+	-- ITEMS is a table of items to turn into a list, and FINAL is an
+	-- optional final cdr.  If it's nil, the list is a "proper" list,
+	-- i.e. it ends in (); otherwise, it's an "improper" list.
 	local function tolist (base, items)
 		if #items == 0 then return base end
 		return tolist(m.cons(table.remove(items), base), items)
 	end
-	return tolist(last or m.null, items)
+	return tolist(final or m.null, items)
 end
 
--- convert a list to a lua table
-function m.totable (cons)
-	local t = {}
-	local car, cdr = cons[1], cons[2]
-	while cdr do
-		table.insert(t, car)
-		if m.luatype(cdr) == "table" then
-			car = cdr[1]
-			cdr = cdr[2]
-		else
-			table.insert(t, cdr)
-		end
-	end
-	return t
+-- strings are vectors of chars
+function m.string (x)
+	local t = tochars(tostring(x))
+	local mt = {
+		__type = "string",
+		__tostring =
+			function (self)
+				local esc =
+					table.concat(self):
+					gsub("[\\\"]", "\\%1")
+				return string.format("\"%s\"", esc)
+			end,
+	}
+	return setmetatable(t, mt)
 end
 
--- testing types
+---[[ TYPE DETECTION AND PREDICATES ]]---
 
--- we love name collisions
+-- to avoid name clashes, `type` is saved in type.luatype
 m.luatype = type
 
+-- return the lam type of a given expression
 function m.lamtype (x)
-	if m.luatype(x) == "string" then
-		return "symbol"
-	elseif getmetatable(x) and getmetatable(x).__type then
+	if getmetatable(x) and getmetatable(x).__type then
 		return getmetatable(x).__type
+	elseif m.luatype(x) == "string" then
+		return "symbol"
 	else
 		return m.luatype(x)
 	end
 end
 
-function m.isa (x, t)
+--- Predicates are named with a `p', lisp-style
+
+-- is X of type T ?
+function m.isp (x, t)
 	return m.lamtype(x) == t
 end
 
-function m.islist (x)
-	-- TODO: detect circular lists
-	if x == m.null then
-		return true
-	elseif m.isa(x, "cons") then
-		return m.islist(x[2])
-	else
-		return false
+-- is X a "proper" list?
+function m.listp (x)
+	-- take advantage of cons' __len operator, but since it returns a
+	-- number, convert that to a bool
+	if m.isp(x, "pair") and #x
+	then return true
+	else return false
 	end
 end
 
-function m.isatom (x)
-	if x == m.null then
-		return true -- '() is the only value that is both atom and list
-	elseif m.luatype(x) == "table" then
-		-- generally, anything that's implemented as a table is *not* an
-		-- atom, at least as I will define it.  (it's not an actual
-		-- scheme procedure)
-		return false
-	else
-		return true
+-- according to CHICKEN, `atom?' returns #t if X is not a pair (cons)
+function m.atomp (x)
+	return not m.isp(x, "pair")
+end
+
+--[[ CONVERTING BACK TO LUA TYPES ]]--
+
+-- convert a cons back to a table
+-- this doesn't special-case for proper/improper lists
+function m.totable (cons)
+	local t, p = {}, cons
+	while p[2] do
+		table.insert(t, p[1])
+		if m.isp(p[2]) == "pair" then
+			p = p[2]
+		else
+			table.insert(t, p[2])
+		end
 	end
+	return t
 end
 
 --------
diff --git a/util.lua b/util.lua
index 8fedbf7..10460a2 100644
--- a/util.lua
+++ b/util.lua
@@ -1,22 +1,35 @@
---- lam.util
+--- lam.util --- utility functions
 
 local m = {}
+local string = string
+local utf8 = require("utf8")
 
+m.luaerror = error
+
+-- signal an error
+-- WHERE is where in the process; DESC is a description of the error; the rest
+-- are "irritants"
+function m.error (desc, ...)
+	m.luaerror(string.format("%s: %s", desc, table.concat({...}, " ")
+	))
+end
+
+-- remove an element from the front of TBL
 function m.pop (tbl)
-	--[[ Remove the first element from TBL. ]]
 	return table.remove(tbl, 1)
 end
 
-function m.assert_arity (r, min, max)
-	local rmin = min or 0
-	local rmax = max or 1/0 -- infinity
-	local rlen = #r
-	if rlen < rmin or rlen > rmax then
-		error(string.format("Wrong arity: %s; expecting %s",
-				rlen,
-				rmin == rmax and rmin or (rmin..".."..rmax)))
+function m.tochars (str)
+	local cs = {}
+	for _, code in utf8.codes(str) do
+		table.insert(cs, code)
 	end
+	return cs
+end
+
+function m.constantly (x)
+	return function () return x end
 end
 
----
+--------
 return m
-- 
cgit 1.4.1-21-gabe81