Add global and types libraries

1 files changed, 141 insertions, 0 deletions

@@ -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