From 5328b62221a3839dca117d71a4703f3ad719c9ce Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Thu, 22 Feb 2024 00:23:32 -0600
Subject: Add global and types libraries
---
eval.lua | 119 ++++++++++-----------------------------------------
global.lua | 141 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
types.lua | 27 ++++++++++++
3 files changed, 190 insertions(+), 97 deletions(-)
create mode 100644 global.lua
create mode 100644 types.lua
diff --git a/eval.lua b/eval.lua
index d441859..cdf4612 100644
--- a/eval.lua
+++ b/eval.lua
@@ -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))))))
- -- ]]
diff --git a/global.lua b/global.lua
new file mode 100644
index 0000000..3805912
--- /dev/null
+++ b/global.lua
@@ -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
diff --git a/types.lua b/types.lua
new file mode 100644
index 0000000..dd105cf
--- /dev/null
+++ b/types.lua
@@ -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
--
cgit 1.4.1-21-gabe81