10 files changed, 350 insertions, 105 deletions

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