Reorganization

11 files changed, 767 insertions, 669 deletions

@@ -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
@@ -0,0 +1,8 @@
+
+utf8  type---.
+  |   /  \    \
+  read   eval  core(environment)
+      \  /     |
+      load<----'
+       |  (require "core"; core.env.load = m.load) ~ and other stuf i spose
+      repl
@@ -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,
+}
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
 
 --------
@@ -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
 
 --------
@@ -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