From ab8a02fd30451207578927c7e69aa397ad596459 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Sat, 30 Mar 2024 22:20:36 -0500
Subject: Read from ports now

---
 Makefile |   2 +-
 base.lua | 257 ---------------------------------------------------
 core.lua |  75 +++++++++++++++
 eval.lua | 102 +++++++++-----------
 read.lua | 318 ++++++++++++++++++++++++++-------------------------------------
 repl.lua |  48 ++++++----
 type.lua | 202 ++++++++++++++++++++++------------------
 7 files changed, 394 insertions(+), 610 deletions(-)
 delete mode 100644 base.lua
 create mode 100644 core.lua

diff --git a/Makefile b/Makefile
index 0e1786c..51b3fc2 100644
--- a/Makefile
+++ b/Makefile
@@ -13,7 +13,7 @@ luarepl:
 
 .PHONY: repl
 repl:
-	$(LUA) -e 'require("repl").repl()'
+	$(LUA) -e 'require("repl").repl("lam> ")'
 
 .PHONY: test
 test:
diff --git a/base.lua b/base.lua
deleted file mode 100644
index b6e3a30..0000000
--- a/base.lua
+++ /dev/null
@@ -1,257 +0,0 @@
---- lam.base --- base environment
-
-local base = {}
-local type = require "type"
-local isNull, isa, totable = type.isNull, type.isa, type.totable
-local math = math
-
-base.env = {
-	-- Equivalence
-	["eqv?"] =
-		function (r)
-			local a, b = r.car, r.cdr.car
-			if a == b then
-				return true
-			else
-				return false
-			end
- 		end,
-	-- ["eq?"] = function (r) end, -- how would this be different to eqv?
-	-- Numbers
-	["number?"] = function (r) return isa(r.car, "Number") end,
-	-- ["complex?"] = function (r) end,
-	-- ["real?"] = function (r) end,
-	-- ["rational?"] = function (r) end,
-	-- ["integer?"] = function (r) end,
-	-- ["exact?"] = function (r) end,
-	-- ["inexact?"] = function (r) end,
-	-- ["exact-integer?"] = function (r) end,
-	-- ["finite?"] = function (r) end,
-	-- ["infinite?"] = function (r) end,
-	["="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n ~= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	["<"] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n >= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	[">"] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n <= r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	["<="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n > r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	[">="] =
-		function (r)
-			local n, r = r.car, r.cdr
-			while r.cdr do
-				if n < r.car then return false end
-				r = r.cdr
-			end
-			return true
-		end,
-	-- Math
-	["+"] =
-		function (r)
-			local r, a = r, 0
-			while r.cdr do
-				r, a = r.cdr, a + r.car
-			end
-			return a
-		end,
-	["-"] =
-		function (r)
-			if isNull(r) then return -1 end
-			if isNull(r.cdr) then return (- r.car) end
-			local r, a = r.cdr, r.car
-			while r.cdr do
-				r, a = r.cdr, a - r.car
-			end
-			return a
-		end,
-	["*"] =
-		function (r)
-			local r, a = r, 1
-			while r.cdr do
-				if r.cdr == 0 then return 0 end
-				r, a = r.cdr, a * r.car
-			end
-			return a
-		end,
-	["/"] =
-		function (r)
-			if isNull(r) then error("Wrong arity") end
-			if isNull(r.cdr) then return (1 / r.car) end
-			local r, a = r.cdr, r.car
-			while r.cdr do
-				r, a = r.cdr, a / r.car
-			end
-			return a
-		end,
-	quotient =
-		function (r)
-		end,
-	remainder =
-		function (r)
-		end,
-	modulo =
-		function (r)
-		end,
-	-- numerator = function (r) end,
-	-- denominator = function (r) end,
-	abs = function (r) return math.abs(r.car) end,
-	floor = -- largest integer <= x
-		function (r) return math.floor(r.car) end,
-	ceiling = -- smallest integer >= x
-		function (r) return math.ceil(r.car) end,
-	truncate = -- smallest |integer| <= |x|
-		function (r)
-			local i, _ = math.modf(r.car)
-			return i
-		end,
-	round = -- closest integer to x (ties go even)
-		function (r)
-			local i, f = math.modf(r.car)
-			if f == 0.5 then
-				if i % 2 == 0 then
-					return i
-				else
-					return i+1
-				end
-			else
-				return i -- is this right?
-			end
-		end,
-	-- Trig
-	exp = function (r) return math.exp(r.car) end,
-	log = function (r) return math.log(r.car) end,
-	pi = math.pi, -- extension
-	sin = function (r) return math.sin(r.car) end,
-	cos = function (r) return math.cos(r.car) end,
-	tan = function (r) return math.tan(r.car) end,
-	asin = function (r) return math.asin(r.car) end,
-	acos = function (r) return math.acos(r.car) end,
-	atan = -- the two-argument variant of atan computes
-		-- (angle (make-rectangular x y)), even in implementations that
-		-- don't support general complex numbers [ed. note: whatever
-		-- that means] --- atan2 ???
-		function (r) return math.atan(r.car) end,
-	sqrt = function (r) return math.sqrt(r.car) end,
-	expt = function (r) return r.car ^ r.cdr.car end,
-	-- ["make-rectangular"] = function (r) end,
-	-- ["make-polar"] = function (r) end,
-	-- ["real-part"] = function (r) end,
-	-- ["imag-part"] = function (r) end,
-	-- ["magnitude"] = function (r) end,
-	-- ["angle"] = function (r) end,
-	-- ["exact->inexact"] = function (r) end,
-	-- ["inexact->exact"] = function (r) end,
-	["number->string"] =
-		function (r)
-			-- this will be somewhat complicated
-		end,
-	["string->number"] =
-		function (r)
-			local n = r.car
-			if not isNull(r.cdr) then
-				local radix = r.cdr.car
-			end
-			-- This is technically an extension to r5rs
-			return tonumber(n, radix)
-		end,
-	-- Pairs
-	["pair?"] = function (r) end,
-	cons = function (r) return type.Cons(r.car, r.cdr.car) end,
-	car = function (r) return r.car.car end,
-	cdr = function (r) return r.car.cdr end,
-	["set-car!"] = function (r) r.car.car = r.cdr.car end,
-	["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
-	-- cxr
-	["null?"] = function (r) return isNull(r.car) end,
-	["list?"] = function (r) return type.isList(r.car) end,
-	list = function (r) return r end, -- r is already a list
-	-- Symbols
-	["symbol?"] = function (r) return isa(r.car, "Symbol") end,
-	["symbol->string"] = function (r) return type.String(r.car) end,
-	["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
-	-- Characters
-	["char?"] = function (r) end,
-	["char=?"] = function (r) end,
-	["char<?"] = function (r) end,
-	["char>?"] = function (r) end,
-	["char<=?"] = function (r) end,
-	["char>=?"] = function (r) end,
-	["char->integer"] = function (r) end,
-	["integer->char"] = function (r) end,
-	-- Strings
-	["string?"] = function (r) end,
-	["make-string"] = function (r) end,
-	["string-length"] = function (r) end,
-	["string-ref"] = function (r) end,
-	-- ["string-set!"] = function (r) end, -- not sure if i'll implement
-	-- Vectors
-	["vector?"] = function (r) end,
-	["make-vector"] = function (r) end,
-	["vector-length"] = function (r) end,
-	["vector-ref"] = function (r) end,
-	["vector-set!"] = function (r) end,
-	-- Control
-	["procedure?"] = function (r) end,
-	apply = function (r) end,
-	["call-with-current-continuation"] = function (r) end,
-	values = function (r) end,
-	["call-with-values"] = function (r) end,
-	["dynamic-wind"] = function (r) end,
-	-- Eval
-	eval = function (r) end,
-	["scheme-report-environment"] = function (r) end,
-	["null-environment"] = function (r) end,
-	-- Ports
-	["input-port?"] = function (r) end,
-	["output-port?"] = function (r) end,
-	["current-input-port"] = function (r) end,
-	["current-output-port"] = function (r) end,
-	["open-input-file"] = function (r) end,
-	["open-output-file"] = function (r) end,
-	["close-input-port"] = function (r) end,
-	["close-output-port"] = function (r) end,
-	-- Input
-	read = function (r) end,
-	["read-char"] = function (r) end,
-	["peek-char"] = function (r) end,
-	["eof-object?"] = function (r) end,
-	["char-ready?"] = function (r) end,
-	-- Output
-	write = function (r) end,
-	display = function (r) end,
-	newline = function (r) end,
-	["write-char"] = function (r) end,
-	-- System
-	load = function (r) end,
-}
-
----
-return base
diff --git a/core.lua b/core.lua
new file mode 100644
index 0000000..e8ad42b
--- /dev/null
+++ b/core.lua
@@ -0,0 +1,75 @@
+--- lam.core --- core procedures
+
+local m = {}
+local type = require "type"
+local isa, null = type.isa, type.null
+local math = math
+
+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
+		return fold(kons, step, r[2])
+	end
+end
+
+m.env = { -- all functions here take R, which is the list of arguments
+	------- numbers
+	["number?"] = function (r) return isa(r[1], "number") end,
+	["="] =
+		function (r)
+			local function go (a, b)
+				if a ~= b then return false, 1 end
+				return b
+			end
+			return fold(go, r[1], r[2]) and true
+		end,
+	["<"] =
+		function (r)
+			local function go (a, b)
+				if a >= b then return false, 1 end
+				return b
+			end
+			return fold(go, r[1], r[2]) and true
+		end,
+	[">"] =
+		function (r)
+			local function go (a, b)
+				if a <= b then return false, 1 end
+				return b
+			end
+			return fold(go, r[1], r[2]) and 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)
+			if r == null then error("Wrong arity") end
+			if r[2] == null then return (1 / r[1]) end
+			return fold(function (a, b) return a/b end, r[1], r[2])
+		end,
+}
+
+--------
+return m
diff --git a/eval.lua b/eval.lua
index 610b902..4a4ad0e 100644
--- a/eval.lua
+++ b/eval.lua
@@ -1,114 +1,100 @@
 --- lam.eval
 
-local eval = {}
-local base = require "base"
+local m = {}
+local core = require "core"
 local type = require "type"
-local isNull, isList, isa, List, Cons =
-	type.isNull, type.isList, type.isa, type.List, type.Cons
-local unpack = table.unpack or unpack
 
-function eval.Env (inner, outer)
+function m.environ (inner, outer)
 	local mt = {
-		__type = "Environment",
+		__type = "environment",
 		__index = outer,
 		__newindex =
-			function (self, key, value)
+			function (self, key, val)
 				if rawget(self, key) then
-					-- Set the current environment's value
-					rawset(self, key, value)
+					rawset(self, key, val)
 				else
-					-- Set the outer value
-					getmetatable(self).__index[key] = value
+					getmetatable(self).__index[key] = val
 				end
 			end,
 	}
 	return setmetatable(inner, mt)
 end
 
-function eval.Proc (params, body, env)
-	local v = {
+function m.procedure (params, body, env)
+	local t = {
 		params = params,
 		body = body,
 		env = env,
 	}
 	local mt = {
-		__type = "Procedure",
+		__type = "procedure",
 		__call =
 			function (self, args)
 				local inner = {}
 				local p, a = self.params, args
-				while p.cdr and a.cdr do
-					inner[p.car] = a.car
-					p, a = p.cdr, a.cdr
+				while p[2] and a[2] do
+					inner[p[1]] = a[1]
+					p, a = p[2], a[2]
 				end
 				local b = self.body
-				local e = eval.Env(inner, self.env)
-				while not isNull(b.cdr) do
-					eval.eval(b.car, e)
-					b = b.cdr
+				local e = m.environ(inner, self.env)
+				while not b[2] == type.null do
+					m.eval(b[1], e)
+					b = b[2]
 				end
-				return eval.eval(b.car, e)
+				return m.eval(b[1], e)
 			end,
 	}
-	return setmetatable(v, mt)
+	return setmetatable(t, mt)
 end
 
 local specials = {
+	-- each of these takes R (a list of args) and E (an environment)
 	quote =
-		function (args, env)
-			return args.car
-		end,
+		function (r, e) return r[1] end,
 	define =
-		function (args, env)
-			rawset(env, args.car, eval(args.cdr.car, env))
-			return nil
-		end,
+		function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end,
 	lambda =
-		function (args, env)
-			return Proc(args.car, args.cdr, env)
-		end,
+		function (r, e) return m.procedure(r[1], r[2], e) end,
 	["set!"] =
-		function (args, env)
-			env[args.car] = eval(args.cdr.car, env)
-			return nil
-		end,
+		function (r, e) e[r[1]] = m.eval(r[2][1], e) end,
 	["if"] =
-		function (args, env)
+		function (r, e)
 			local test, conseq, alt =
-				args.car, args.cdr.car, args.cdr.cdr.car
-			if eval(test)
-			then return eval(conseq)
-			else return eval(alt)
+				r[1], r[2][1], r[2][2][1]
+			if m.eval(test)
+			then return m.eval(conseq)
+			else return m.eval(alt)
 			end
 		end,
-	-- TODO: include, import, define-syntax, define-values(?) ...
+	-- TODO: include, import, define-syntax, ...
 }
 -- Aliases
 specials.lam = specials.lambda
 specials.def = specials.define
 
-function eval.eval (x, env)
-	env = env or base.env
-	if isa(x, "Symbol") then
+function m.eval (x, env)
+	local env = env or core.env
+	if type.isa(x, "symbol") then
 		return env[x]
-	elseif not isList(x) then
+	elseif not type.islist(x) then
 		return x
 	else
-		local op, args = x.car, x.cdr
+		local op, args = x[1], x[2]
 		if specials[op] then
 			return specials[op](args, env)
-		else		-- procedure
-			local proc = eval.eval(op, env)
+		else		-- procedure call
+			local fn = m.eval(op, env)
 			local params = {}
-			local a = args
-			while a.cdr do
-				table.insert(params, eval.eval(a.car, env))
-				a = a.cdr
+			local r = args
+			while r[2] do
+				table.insert(params, m.eval(r[1], env))
+				r = r[2]
 			end
-			return proc(List(params))
+			return fn(type.list(params))
 		end
 	end
 end
 
----
-return eval
+--------
+return m
diff --git a/read.lua b/read.lua
index f23c5cc..226af51 100644
--- a/read.lua
+++ b/read.lua
@@ -1,230 +1,170 @@
 --- lam.read
 
-local read = {}
-local type = require "type"
+local m = {}
+local t = require "type"
 local utf8 = require "utf8"
-local util = require "util"
-local pop = util.pop
-local unpack = table.unpack or unpack
-
-local function program_characters (program)
-	local chars = {}
-	for pos, code in utf8.codes(program) do
-		table.insert(chars, code)
-	end
-	return chars
-end
-
-local function consume_string_whitespace (chars)
-	-- \<intraline ws>*<line ending> <intraline ws>* : nothing
-	local s = {"\\"}
-	while chars[1]:match("[ \t]") do
-		table.insert(s, 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
-		pop(chars)
+local pop = require("util").pop
+
+local pp = require("pp").pp
+
+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 kind == "file" then
+			f = io.open(source, "r")
+		elseif kind == "string" then
+			l = m.tochars(source)
+		end
+	else
+		-- KIND is ignored here
+		f = io.input()
 	end
-	return chars[1], chars
-end
-
-local function consume_string_hexvalue (chars)
-	-- \x<hex scalar value>; : specified character
-	local u8ch = {}
-	repeat
-		local c = pop(chars)
-		table.insert(u8ch, c)
-	until c == ";"
-	table.remove(u8ch) -- remove semicolon
-	return utf8.char(tonumber(table.concat(u8ch), 16)), chars
-end
-
-local function consume_string (chars)
-	local str = {}
-	local backslash = {
-		a = "\a",
-		b = "\b",
-		t = "\t",
-		n = "\n",
-		r = "\r",
-		["\""] = "\"",
-		["\\"] = "\\",
-		["|"] = "|",
-		[" "] = consume_string_whitespace,
-		["\t"] = consume_string_whitespace,
-		["\n"] = consume_string_whitespace,
-		x = consume_string_hexvalue,
-	}
-	pop(chars) -- throw initial " away
-	repeat
-		local c = pop(chars)
-		if c == [[\]] then
-			c = chars[1]
-			if backlash[c] then
-				if type(backslash[c]) == "function" then
-					c, chars = backslash[c](chars)
-					table.insert(str, c)
-				else
-					table.insert(str, backlash[c])
+	local t = {
+		file = f,
+		line = l or {},
+		next_token =
+			function (self)
+				local tok, toktype
+				while true do
+					if #self.line == 0 and self.file then
+						self.line = m.tochars(
+							self.file:read("*l"))
+					end
+					if not self.line or #self.line == 0 then
+						return nil
+					end
+					tok, toktype, self.line =
+						m.scan(self.line)()
+					if tok then return tok, toktype end
 				end
-			else
-				table.insert(str, "\\"..c)
-			end
-			pop(chars)
-		elseif c == [["]] then
-			break
-		else
-			table.insert(str, c)
-		end
-	until #chars == 0
-	return table.concat(str), "string", chars
+			end,
+	}
+	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
 
-local function consume_token (chars)
-	local tok = {}
-	while #chars>0 and chars[1]:match("[^%s()\"#'`,@;]") do
-		table.insert(tok, pop(chars))
+function m.tochars (s)
+	local chars = {}
+	for _, code in utf8.codes(s) do
+		table.insert(chars, code)
 	end
-	return table.concat(tok), chars
+	return chars
 end
 
-local consume_symbol = consume_token
+--- Consumers
+-- These take a table of characters (cs) and return a token and the rest of the
+-- chars
 
-local function consume_number (chars)
-	local digits, chars = consume_token(chars)
-	-- The signs by themselves are symbols, as well as '...'
-	if digits:match("[-+.]") or digits == "..." then
-		return digits, chars
+local function consume_token (cs)
+	local token = {}
+	while #cs > 0 and cs[1]:match("[^%s()\"#'`,@;]") do
+		table.insert(token, pop(cs))
 	end
-	-- Otherwise try converting the digits to a number
-	local num = tonumber(digits)
-	if num == nil then error("Bad number: " .. num) end
-	return num, chars
+	return table.concat(token), cs
 end
 
-local function consume_whitespace (chars)
-	while #chars>0 and chars[1]:match("%s") do pop(chars) end
-	return chars
+local function consume_whitespace (cs)
+	while #cs > 0 and cs[1]:match("%s") do pop(cs) end
+	return nil, cs
 end
 
-local function consume_comment (chars)
-	local comment = {}
-	repeat
-		table.insert(comment, pop(chars))
-	until #chars == 0 or chars[1]:match("\n")
-	return table.concat(comment), "comment", chars
-end
+--- Reading from a port
 
---- API
-
-read.readtable = {
-	["("] = function(chars) return pop(chars), "open", chars end,
-	[")"] = function(chars) return pop(chars), "close", chars end,
-	["'"] = function(chars) return pop(chars), "quote", chars end,
-	["`"] = function(chars) return pop(chars), "quote", chars end,
-	[","] = function(chars) return pop(chars), "quote", chars end,
-	["\""] = consume_string,
-	[";"] = consume_comment,
-	-- ["#"] = ...,
+m.readtable = {
+	["("] = function (cs) return pop(cs), "open", cs end,
+	[")"] = function (cs) return pop(cs), "close", cs end,
 }
 
-function read.scan (chars)
-	local chars = chars
+-- 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(chars) then return nil end
-		local token, toktype = "", nil
+		if not next(cs) then return nil end
+		local token, toktype
 		while true do
-			if read.readtable[chars[1]] then
-				token, toktype, chars =
-					read.readtable[chars[1]](chars)
-				return token, toktype
-			elseif chars[1]:match("%s") then
-				chars = consume_whitespace(chars)
-			elseif chars[1]:match("%d") then
-				token, chars = consume_number(chars)
-				return token, "number"
-			elseif chars[1]:match("[.+-]") then
-				-- special casing for ., ..., +, -
-				token, chars = consume_number(chars)
-				if token == "." then
-					return token, "dot"
-				elseif token == "..." then
-					return token, "symbol"
+			if m.readtable[cs[1]] then
+				token, toktype, cs = m.readtable[cs[1]](cs)
+				-- return { v = token, u = toktype }, cs
+				return token, toktype, cs
+			elseif cs[1]:match("%s") then
+				_, cs = consume_whitespace(cs)
+				return nil, nil, cs
+				-- return nil, cs
+			elseif cs[1]:match("[%d.+-]") then
+				-- numbers, +, -, ., ...
+				local token, cs = consume_token(cs)
+				if token:match("[-+]") or token == "..." then
+					return token, "symbol", cs
+					-- return { v = token, u = "symbol" }, cs
+				elseif token == "." then
+					return token, "dot", cs
+					-- return { v = token, u = "dot" }, cs
 				else
-					return token, "number"
+					local n = tonumber(token)
+					assert (n ~= nil, "Bad number: "..n)
+					return n, "number", cs
+					-- return { v = n, u = "number" }, cs
 				end
 			else
-				token, chars = consume_symbol(chars)
-				return token, "symbol"
+				token, cs = consume_token(cs)
+				return token, "symbol", cs
+				-- return { v = token, u = "symbol" }, cs
 			end
-			if #chars == 0 then return nil end
 		end
 	end
 end
 
-function read.tokenize (program)
-	if not program or #program == 0 then return nil end
-	local tokens = {}
-	for token, toktype in read.scan(program_characters(program)) do
-		table.insert(tokens, {type = toktype, value = token})
+function m.readchar (port)
+	if #port.line > 0 then
+		local ch = pop(port.line)
+		return ch
+	else
+		return port.file.read(1)
 	end
-	return tokens
 end
 
-read.readmacros = {
-	open =
-		function (token, tokens)
-			local L, lt = {}, nil
-			while tokens[1].type ~= "close" do
-				local nt = read.parse(tokens)
-				-- this isn't .. my /favorite/ implementation,
-				-- but it works
-				if nt == "." then
-					lt = read.parse(tokens)
-					break
+function m.read (port)
+	local function read_ahead (tok, toktype)
+		if not tok then error("Unexpected EOF") end
+		if toktype == "open" then
+			local L = {}
+			while true do
+				local tok, toktype = port:next_token()
+				if toktype == "close" then
+					return t.list(L)
 				else
-					table.insert(L, nt)
+					table.insert(L,
+						read_ahead(tok, toktype))
 				end
-				assert(tokens[1], "Unexpected EOF")
 			end
-			pop(tokens)	-- remove final ")"
-			return type.List(L, lt)
-		end,
-	close =
-		function (token, tokens)
-			error ("Unexpected '" .. token.value .. "'")
-		end,
-	quote =
-		function (token, tokens)
-			local Q
-			if token.value == "'" then
-				Q = {"quote"}
-			elseif token.value == "`" then
-				Q = {"quasiquote"}
-			elseif token.value == "," then
-				Q = {"unquote"}
-			end
-			table.insert(Q, read.parse(tokens))
-			return type.List(Q)
-		end,
-}
-
-function read.parse (tokens)
-	if not next(tokens) then return nil end
-	local token = pop(tokens)
-	if read.readmacros[token.type] then
-		return read.readmacros[token.type](token, tokens)
-	else
-		return token.value
+		elseif toktype == "close" then
+			error("Unexpected ')'")
+		else return tok
+		end
+	end
+	-- body of read
+	local tok1, toktype1 = port:next_token()
+	if not tok1 then return nil
+	else return read_ahead(tok1, toktype1)
 	end
 end
 
-function read.read (program)
-	return read.parse(read.tokenize(program))
+function m.read_string (str)
+	return m.read(m.inport(str, "string"))
 end
 
 ---
-return read
+return m
diff --git a/repl.lua b/repl.lua
index b198880..556525c 100644
--- a/repl.lua
+++ b/repl.lua
@@ -1,10 +1,12 @@
 --- lam.repl
 
-local repl = {}
-local eval = require("eval").eval
-local read = require("read").read
+local m = {}
+local read = require("read")
+local eval = require("eval")
+local pp = require("pp").pp
 
 local function schemeprint (x)
+	-- if x == nil then return end
 	if x == true then
 		print("#t")
 	elseif x == false then
@@ -14,19 +16,33 @@ local function schemeprint (x)
 	end
 end
 
-function repl.repl (prompt)
-	if not prompt then prompt = "lam> " end
-	io.input():setvbuf("line")
-	repeat
-		io.write(prompt)
-		io.output():flush()
-		local input = io.read()
-		if input ~= "" then
-			local value = eval(read(input))
-			if value ~= nil then schemeprint(value) end
+function m.repl (prompt, infile, out)
+	-- PROMPT should be a string, INFILE is a filename, and OUT is either a
+	-- filename, nil (in which case it will be stdout), or false (which
+	-- suppresses output)
+	local inport = read.inport(infile)
+	if out ~= false then io.output(out) end
+	io.output():setvbuf("line")
+	if prompt then
+		stderr = io.open("/dev/stderr", "w") -- Linux-only !
+	end
+	while true do
+		if prompt then
+			stderr:write(prompt)
+			stderr:flush()
+		end
+		local x = read.read(inport)
+		if x then
+			local val = eval.eval(x)
+			if out ~= false then
+				schemeprint(val)
+			end
 		end
-	until false
+	end
+	inport:close()
+	stderr:close()
+	io.output():close()
 end
 
----
-return repl
+--------
+return m
diff --git a/type.lua b/type.lua
index 0a0c62d..3c26188 100644
--- a/type.lua
+++ b/type.lua
@@ -1,138 +1,162 @@
 --- lam.type
--- lisp types
 
-local t = {}
-local util = require "util"
-local unpack = table.unpack or unpack
+local m = {}
+local utf8 = require "utf8"
+utf_char, utf_codepoint = utf8.char, utf8.codepoint
 
---- Determining types
+--- atomic types
 
-t.luatype = type
+-- true, false and nil are just ... true, false, and nil
 
-function t.lamtype (x)
-	if t.luatype(x) == "number" then
-		return "Number"
-	elseif t.luatype(x) == "string" then
-		return "Symbol"
-	elseif getmetatable(x) and getmetatable(x).__type then
-		return getmetatable(x).__type
-	else
-		return t.luatype(x)
-	end
-end
-
--- isa is really only useful on basic types (i.e., not Lists)
-function t.isa (x, type)
-	return t.lamtype(x) == type
+-- 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),
+		u = uc,
+	}
+	local mt = {
+		__type = "character",
+		__eq = function (self) return self.v 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
+				end
+			end,
+	}
+	return setmetatable(t, mt)
 end
 
---- Creating types
-
--- Symbols and Numbers are strings and numbers, respectively.  At some point
--- I'll want to implement a full numeric tower and symbol tables or namespaces
--- or whatever, but today is not that day
+-- 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
 
-t.Symbol = tostring
-t.Number = tonumber
+-- for now, number will just be lua's number.  At *some* point, it will be the
+-- whole numeric tower, yaaayyy
+m.number = tonumber
 
--- Strings are (lightly) wrapped
-function t.String (str)
-	local v = {
-		value = str,
+-- strings are wrapped strings
+function m.string (x)
+	local x = tostring(x)
+	local t = {
+		v = x,
 		escape =
 			function (self)
-				return self.gsub("[\\\"]", "\\%1")
+				return self.v:gsub("[\\\"]", "\\%1")
 			end,
 	}
 	local mt = {
-		__type = "String",
+		__type = "string",
 		__tostring =
 			function (self)
-				return string.format("\"%s\"", self:escape())
+				return "\"" .. self:escape() .. "\""
 			end,
 	}
-	return setmetatable(v, mt)
+	return setmetatable(t, mt)
 end
 
-function t.totable (cons)
-	local out = {}
-	local car, cdr = cons.car, cons.cdr
-	while cdr do
-		table.insert(out, tostring(car))
-		if t.luatype(cdr) == "table" then
-			car = cdr.car
-			cdr = cdr.cdr
-		else
-			table.insert(out, cdr)
-			break
-		end
-	end
-	return out
-end
+-- null () is both an atom and a list (yay)
+-- this one is NOT a function
+m.null = setmetatable({}, {
+		__type = "null",
+		__tostring = function (self) return "()" end,
+})
+
+--- collection types
 
--- Conses are Lisp's fundamental collection type
-function t.Cons (a, b)
-	local v = { a, b, }
+-- cons are lisp's fundamental collection type
+function m.cons (a, b)
+	local t = { a, b, }
 	local mt = {
-		__type = "Cons",
-		__index =
-			function (self, key)
-				if key == "car" then
-					return self[1]
-				elseif key == "cdr" then
-					return self[2]
-				end
-			end,
+		__type = "cons",
 		__tostring =
 			function (self)
 				local out = {}
-				local car, cdr = self.car, self.cdr
+				local car, cdr = self[1], self[2]
 				while cdr do
 					table.insert(out, tostring(car))
-					if t.luatype(cdr) == "table" then
-						car = cdr.car
-						cdr = cdr.cdr
+					if m.luatype(cdr) == "table" then
+						car = cdr[1]
+						cdr = cdr[2]
 					else
 						table.insert(out, ".")
 						table.insert(out, cdr)
 						break
 					end
 				end
-				return "("..table.concat(out, " ")..")"
+				return "(" .. table.concat(out, " ") .. ")"
 			end,
 	}
-	return setmetatable(v, mt)
+	return setmetatable(t, mt)
 end
 
--- Null is the one value that is both an atom and a list
-t.Null = setmetatable({}, {
-		__type = "Null",
-		__tostring = function (self) return "()" 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 ().
+	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)
+end
 
-function t.isNull (x)
-	return x == t.Null
+-- 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
 end
 
--- Lists are chained Conses ending in Null
-function t.List (items, last)
-	local function tolist (base, items)
-		if #items == 0 then return base end
-		return tolist(t.Cons(table.remove(items), base), items)
+-- testing types
+
+-- we love name collisions
+m.luatype = type
+
+function m.lamtype (x)
+	if m.luatype(x) == "string" then
+		return "symbol"
+	elseif getmetatable(x) and getmetatable(x).__type then
+		return getmetatable(x).__type
+	else
+		return m.luatype(x)
 	end
-	return tolist(last or t.Null, items)
 end
 
-function t.isList (x)
-	-- TODO: this does not detect circular lists yet
-	if t.isNull(x) then
+function m.isa (x, t)
+	return m.lamtype(x) == t
+end
+
+function m.islist (x)
+	-- TODO: detect circular lists
+	if x == m.null then
 		return true
-	elseif t.isa(x, "Cons") then
-		return t.isList(x.cdr)
+	elseif m.isa(x, "cons") then
+		return m.islist(x[2])
 	else
 		return false
 	end
 end
 
----
-return t
+--------
+return m
-- 
cgit 1.4.1-21-gabe81