Read from ports now

7 files changed, 394 insertions, 610 deletions

@@ -13,7 +13,7 @@ luarepl:
 
 .PHONY: repl
 repl:
-        $(LUA) -e 'require("repl").repl()'
+        $(LUA) -e 'require("repl").repl("lam> ")'
 
 .PHONY: test
 test:
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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