6 files changed, 374 insertions, 0 deletions

@@ -0,0 +1,145 @@
+--- lam.eval
+
+local eval = {}
+local read = require "read"
+local types = require "types"
+local util = require "util"
+local pp = require "pp"
+
+Env = types.Object:new {
+        __type = "Environment",
+        __extend =
+                function(self, parms, args, outer)
+                        for _, p in ipairs(parms) do
+                                for _, a in ipairs(args) do
+                                        self[p] = a
+                                end
+                        end
+                        getmetatable(self).__index = outer
+                end,
+}
+
+Proc = types.Object:new {
+        __type = "Procedure",
+        __call =
+                function (self, args)
+                        local e = Env:new()
+                        e:__extend(self.parms,
+                                   util.table(args),
+                                   self.env)
+                        return eval(self.body[1], e)
+                end
+}
+
+global_env = Env:new {
+        -- constants
+        ["#t"] = true,
+        ["#f"] = false,
+        -- basic math
+        ["+"] =
+                function (...)
+                        print(...)
+                        return util.reduce(
+                                {...}, 0,
+                                function (a, b) return a + b end)
+                end,
+        ["*"] =
+                function (...)
+                        return util.reduce(
+                                {...}, 1,
+                                function (a, b) return a * b end)
+                end,
+        -- scheme predicates
+        ["null?"] =
+                function(x)
+                        return x == {}
+                end,
+        ["number?"] =
+                function(x)
+                        return types.Type(x) == "Number"
+                end,
+        ["symbol?"] =
+                function(x)
+                        return types.Type(x) == "Symbol"
+                end,
+        -- scheme functions
+        ["apply"] =
+                function(fn, ...)
+                        local args = {...}
+                        local last = args[#args]
+                        assert(type(last)=="table", "Bad apply")
+                        table.remove(args)
+                        for _,v in ipairs(last) do
+                                table.insert(args, v)
+                        end
+                        return fn(table.unpack(args))
+                end,
+        ["begin"] =
+                function(...)
+                        local xs = {...}
+                        return xs[#xs]
+                end,
+        ["map"] =
+                function(fn, ...)
+                        return util.map(fn, {...})
+                end,
+        ["car"] = util.car,
+        ["cdr"] = util.cdr,
+        ["list"] = function(...) return {...} end,
+}
+
+-- Math
+for k, v in pairs(math) do
+        global_env[k] = v
+end
+
+function eval.eval (x, env)
+        env = env or global_env
+        if types.Type(x) == "Symbol" then
+                return env[x]
+        elseif types.Type(x) ~= "List" then
+                return x
+        else
+                local op = util.car(x)
+                local args = util.cdr(x)
+                if op == "quote" then
+                        return args[1]
+                elseif op == "define" then
+                        local sym, exp = table.unpack(args)
+                        env[sym] = eval(exp, env)
+                elseif op == "set!" then
+                        local sym, exp = table.unpack(args)
+                        env[sym] = eval(exp, env)
+                elseif op == "lambda" then
+                        local parms = util.car(args)
+                        local body = util.cdr(args)
+                        return Proc:new {
+                                parms = parms,
+                                body = body,
+                                env = env,
+                        }
+                else            -- procedure call
+                        pp(op)
+                        local proc = eval(op, env)
+                        local vals = util.map(
+                                function(v) return eval(v, env) end,
+                                args)
+                        return proc(table.unpack(vals))
+                end
+        end
+end
+
+---
+return setmetatable(eval, { __call =
+                                    function(_, x, env)
+                                            local success, result =
+                                                    pcall(eval.eval, x, env)
+                                            if success then return result
+                                            else return ("ERROR: " .. result)
+                                            end
+                                    end
+})
+
+--[[
+        (begin (define sq (lambda (x) (* x x))) (define rep (lambda (f) (lambda (x) (f (f x))))))
+-- ]]
@@ -0,0 +1,36 @@
+--- lam.pp
+
+local pp = {}
+
+function pp.dump (x, lvl)
+        lvl = lvl or 0
+        local space = string.rep(" ", lvl)
+        local output = ""
+        if type(x) == "table" then
+                local subo = ""
+                for k,v in pairs(x) do
+                        if v == x then
+                                v = "self"
+                        else
+                                v = pp.dump(v, lvl+2)
+                        end
+                        subo = subo .. string.format("\n%s[%s] = %s,",
+                                                     (space.."  "), k, v)
+                end
+                output = output .. string.format("\n%s{%s\n%s}",
+                                                 space, subo, space)
+        else
+                output = output .. string.format("%s", x)
+        end
+        return output
+end
+
+function pp.pp (x)
+        print(pp.dump(x))
+end
+
+return setmetatable(pp, { __call =
+                                  function(_, x)
+                                          return pp.pp(x)
+                                  end,
+})
@@ -0,0 +1,74 @@
+--- lam.read
+
+local read = {}
+
+local types = require "types"
+local util = require "util"
+
+function read.tokenize (str)
+        --[[ Convert a string of characters into a list of tokens ]]
+        assert(str, "No program given")
+        local tbl = {}
+        local word = ""
+        local push_word =
+                function ()
+                        if word:len() > 0 then
+                                table.insert(tbl, word)
+                                word = ""
+                        end
+                end
+
+        for c = 1, #str do
+                char = string.char(str:byte(c))
+                if char == " " or char == "\t" or char == "\n" then
+                        push_word()
+                elseif char == "(" then
+                        push_word()
+                        table.insert(tbl, "(")
+                elseif char == ")" then
+                        push_word()
+                        table.insert(tbl, ")")
+                else
+                        word = word .. char
+                end
+        end
+        push_word()
+        return tbl
+end
+
+function read.read (str)
+        -- [[ Read a scheme expression from a string ]]
+
+        local function Atom (token)
+                local n = tonumber(token)
+                if n then return n
+                else return tostring(token)
+                end
+        end
+
+        local function read_tokens (tokens)
+                --[[ Read a list of tokens from `tokenize' ]]
+                assert(next(tokens), "Unexpected EOF")
+                token = util.pop(tokens)
+                if token == "(" then
+                        local L = {}
+                        while tokens[1] ~= ")" do
+                                table.insert(L, read_tokens(tokens))
+                        end
+                        util.pop(tokens)                       --  remove ")"
+                        return L
+                elseif token == ")" then
+                        error("Unexpected ')'")
+                else
+                        return Atom(token)
+                end
+        end
+
+        return read_tokens(read.tokenize(str))
+end
+
+return setmetatable(read, { __call =
+                                    function(_, str)
+                                            return read.read(str)
+                                    end,
+})
@@ -0,0 +1,41 @@
+--- lam.repl
+
+local repl = {}
+local eval = require "eval"
+local read = require "read"
+local util = require "util"
+
+function schemestr(x)
+        if type(x) == "table" then
+                local ts = "(" .. schemestr(util.pop(x))
+                for i,v in ipairs(x) do
+                        ts = string.format("%s %s", ts, schemestr(v))
+                end
+                ts = ts .. ")"
+                return ts
+        elseif x == true then
+                return "#t"
+        elseif x == false then
+                return "#f"
+        else
+                return tostring(x)
+        end
+end
+
+function repl.repl (prompt)
+        prompt = prompt or "lam> "
+        repeat
+                io.write(prompt)
+                io.output():flush()
+                input = io.read()
+                if input == ",q" or input == ",quit" then
+                        break
+                else
+                        val = eval(read(input))
+                        if val then print(schemestr(val)) end
+                end
+        until false
+end
+
+---
+return repl
@@ -0,0 +1,37 @@
+--- lam.types
+
+local types = {}
+
+function types.Type(x)
+        if type(x) == "string" then
+                -- Symbols are Lua strings
+                return "Symbol"
+        elseif type(x) == "number" then
+                -- Numbers are Lua numbers
+                return "Number"
+        elseif x.__type then
+                return x.__type
+        elseif type(x) == "table" then
+                -- Lists are Lua tables (non-adorned)
+                return "List"
+        else
+                return type(x)
+        end
+end
+
+types.Object = { __type = "Object" }
+function types.Object:new(o)
+        o = o or {}
+        setmetatable(o, self)
+        self.__index = self
+        return o
+end
+
+--- Boxed types
+
+-- Strings
+
+-- Lists
+
+---
+return types
@@ -0,0 +1,41 @@
+--- lam.util
+
+local util = {}
+
+function util.table (x)
+        if type(x) == "table" then
+                return x
+        else
+                return { x }
+        end
+end
+
+function util.pop (tbl)
+        return table.remove(tbl, 1)
+end
+
+function util.car (tbl)
+        return tbl[1]
+end
+
+function util.cdr (tbl)
+        local t = {}
+        for i = 2, #tbl do t[i-1] = tbl[i] end
+        return t
+end
+
+function util.reduce (tbl, seed, fn)
+        if #tbl == 0 then return seed end
+        return util.reduce(tbl, fn(seed, util.pop(tbl)), fn)
+end
+
+function util.map (fn, tbl)
+        local out = {}
+        for k, v in pairs(tbl) do
+                out[k] = fn(v)
+        end
+        return out
+end
+
+---
+return util