Initial commit

1 files changed, 145 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))))))
+-- ]]