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