Add global and types libraries

3 files changed, 190 insertions, 97 deletions

@@ -4,23 +4,10 @@ local eval = {}
 local read = require "read"
 local util = require "util"
 local pp = require "pp"
+local global = require "global"
+local types = require("types")
 
-local function Type (x)
-        if type(x) == "string" then
-                return "Symbol"
-        elseif type(x) == "number" then
-                return "Number"
-        elseif getmetatable(x) and getmetatable(x).__type then
-                return x.__type
-        elseif type(x) == "table" then
-                return "List"
-        else
-                return type(x)
-        end
-end
-
-local Symbol = tostring
-local Number = tonumber
+if not table.unpack then table.unpack = unpack end
 
 local function Env(inner, outer)
         return setmetatable(inner, { __type = "Environment", __index = outer, })
@@ -48,73 +35,11 @@ local function Proc(params, body, env)
         return setmetatable(p, mt)
 end
 
-local global_env = {
-        -- 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 Type(x) == "Number"
-                end,
-        ["symbol?"] =
-                function(x)
-                        return 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 Type(x) == "Symbol" then
-                return env[x]
-        elseif type(x) ~= "table" then
+function eval.eval (x, e)
+        e = e or global
+        if types.lamtype(x) == "Symbol" then
+                return e[x]
+        elseif types.luatype(x) ~= "table" then
                 return x
         else
                 local op = util.car(x)
@@ -123,20 +48,24 @@ function eval.eval (x, env)
                         return args[1]
                 elseif op == "define" then
                         local sym, exp = table.unpack(args)
-                        env[sym] = eval(exp, env)
+                        e[sym] = eval(exp, e)
                         --[[
                                 elseif op == "set!" then
                                 local sym, exp = table.unpack(args)
-                                env[sym] = eval(exp, env) --]]
+                                e[sym] = eval(exp, e) --]]
                 elseif op == "lambda" then
                         local params = util.car(args)
-                        local body = util.cdr(args)[1]
-                        return Proc(params, body, env)
+                        local body = util.cdr(args)
+                        table.insert(body, 1, "begin")
+                        return Proc(params,
+                                    body,
+                                    e)
                 else            -- procedure call
-                        local proc = eval(op, env)
-                        local vals = util.map(
-                                function(v) return eval(v, env) end,
-                                args)
+                        local proc = eval(op, e)
+                        local vals = {}
+                        for k, v in pairs(args) do
+                                vals[k] = eval(v, e)
+                        end
                         return proc(table.unpack(vals))
                 end
         end
@@ -144,15 +73,11 @@ end
 
 ---
 return setmetatable(eval, { __call =
-                                    function(_, x, env)
+                                    function(_, x, e)
                                             local success, result =
-                                                    pcall(eval.eval, x, env)
+                                                    pcall(eval.eval, x, e)
                                             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,141 @@
+--- lam.environment
+
+local util = require "util"
+local types = require("types")
+
+if not table.unpack then table.unpack = unpack end
+
+local global = {
+        -- constants
+        ["#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
+
+--- Basic functions ---
+
+global.begin = function(...)
+        local xs = {...}
+        return xs[#xs]
+end
+
+global.car = util.car
+global.cdr = util.cdr
+
+global.list = function(...) return {...} end
+
+--- Higher-order functions ---
+
+global.apply = function(fn, ...)
+        local args = {...}
+        local last = args[#args]
+        assert(types.luatype(last) == "table", "Bad apply")
+        table.remove(args)
+        for _, v in ipairs(last) do
+                table.insert(args, v)
+        end
+        return fn(table.unpack(args))
+end
+
+global.map = function(fn, list)
+        return util.map(fn, list)
+end
+
+--- Math ---
+-- NOTE: we do not have the full numeric tower yet!
+
+for name, func in pairs(math) do
+        global[name] = func
+end
+
+global["+"] = function (...)
+        return util.reduce({...}, 0, function (a, b) return a + b end)
+end
+
+global["-"] = function (...)
+        local args = {...}
+        if #args == 0 then
+                error("Too few arguments: need at least 1")
+        elseif #args == 1 then
+                return (-args[1])
+        else
+                local result = args[1]
+                for v = 2, #args do
+                        result = result - args[v]
+                end
+                return result
+        end
+end
+
+global["*"] = function (...)
+        local result = 1
+        for _, v in ipairs({...}) do
+                if v == 0 then return 0 end
+                result = result * v
+        end
+        return result
+end
+
+global["/"] = function (...)
+        local args = {...}
+        if #args == 0 then
+                error("Too few arguments: need at least 1")
+        elseif #args == 1 then
+                if args[1] == 0 then error("Division by zero") end
+                return (1/args[1])
+        else
+                local result = args[1]
+                for v = 2, #args do
+                        if args[v] == 0 then error("Division by zero") end
+                        result = result / args[v]
+                end
+                return result
+        end
+end
+
+global["="] = function (...)
+        for _, v in ipairs({...}) do
+                if not a == b then return false end
+        end
+        return true
+end
+
+global["<"] = function (...)
+        for _, v in ipairs({...}) do
+                if not a < b then return false end
+        end
+        return true
+end
+
+global["<="] = function (...)
+        for _, v in ipairs({...}) do
+                if not a <= b then return false end
+        end
+        return true
+end
+
+global[">"] = function (...)
+        for _, v in ipairs({...}) do
+                if not a > b then return false end
+        end
+        return true
+end
+
+global[">="] = function (...)
+        for _, v in ipairs({...}) do
+                if not a >= b then return false end
+        end
+        return true
+end
+
+---
+return global
@@ -0,0 +1,27 @@
+--- lam.types
+
+local types = {}
+
+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)
+        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["null?"] = function (x) return x == {} end
+
+---
+return types