From 70ec5254814f9531e5ca2024465d0e01130306b7 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 21 Feb 2024 09:28:49 -0600 Subject: Initial commit --- eval.lua | 145 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ pp.lua | 36 ++++++++++++++++ read.lua | 74 ++++++++++++++++++++++++++++++++ repl.lua | 41 ++++++++++++++++++ types.lua | 37 ++++++++++++++++ util.lua | 41 ++++++++++++++++++ 6 files changed, 374 insertions(+) create mode 100644 eval.lua create mode 100644 pp.lua create mode 100644 read.lua create mode 100644 repl.lua create mode 100644 types.lua create mode 100644 util.lua diff --git a/eval.lua b/eval.lua new file mode 100644 index 0000000..3decded --- /dev/null +++ b/eval.lua @@ -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)))))) +-- ]] diff --git a/pp.lua b/pp.lua new file mode 100644 index 0000000..3710b07 --- /dev/null +++ b/pp.lua @@ -0,0 +1,36 @@ +--- lam.pp + +local pp = {} + +function pp.dump (x, lvl) + lvl = lvl or 0 + local space = string.rep(" ", lvl) + local output = "" + if type(x) == "table" then + local subo = "" + for k,v in pairs(x) do + if v == x then + v = "self" + else + v = pp.dump(v, lvl+2) + end + subo = subo .. string.format("\n%s[%s] = %s,", + (space.." "), k, v) + end + output = output .. string.format("\n%s{%s\n%s}", + space, subo, space) + else + output = output .. string.format("%s", x) + end + return output +end + +function pp.pp (x) + print(pp.dump(x)) +end + +return setmetatable(pp, { __call = + function(_, x) + return pp.pp(x) + end, +}) diff --git a/read.lua b/read.lua new file mode 100644 index 0000000..72bbd4d --- /dev/null +++ b/read.lua @@ -0,0 +1,74 @@ +--- lam.read + +local read = {} + +local types = require "types" +local util = require "util" + +function read.tokenize (str) + --[[ Convert a string of characters into a list of tokens ]] + assert(str, "No program given") + local tbl = {} + local word = "" + local push_word = + function () + if word:len() > 0 then + table.insert(tbl, word) + word = "" + end + end + + for c = 1, #str do + char = string.char(str:byte(c)) + if char == " " or char == "\t" or char == "\n" then + push_word() + elseif char == "(" then + push_word() + table.insert(tbl, "(") + elseif char == ")" then + push_word() + table.insert(tbl, ")") + else + word = word .. char + end + end + push_word() + return tbl +end + +function read.read (str) + -- [[ Read a scheme expression from a string ]] + + local function Atom (token) + local n = tonumber(token) + if n then return n + else return tostring(token) + end + end + + local function read_tokens (tokens) + --[[ Read a list of tokens from `tokenize' ]] + assert(next(tokens), "Unexpected EOF") + token = util.pop(tokens) + if token == "(" then + local L = {} + while tokens[1] ~= ")" do + table.insert(L, read_tokens(tokens)) + end + util.pop(tokens) -- remove ")" + return L + elseif token == ")" then + error("Unexpected ')'") + else + return Atom(token) + end + end + + return read_tokens(read.tokenize(str)) +end + +return setmetatable(read, { __call = + function(_, str) + return read.read(str) + end, +}) diff --git a/repl.lua b/repl.lua new file mode 100644 index 0000000..3cdfe4e --- /dev/null +++ b/repl.lua @@ -0,0 +1,41 @@ +--- lam.repl + +local repl = {} +local eval = require "eval" +local read = require "read" +local util = require "util" + +function schemestr(x) + if type(x) == "table" then + local ts = "(" .. schemestr(util.pop(x)) + for i,v in ipairs(x) do + ts = string.format("%s %s", ts, schemestr(v)) + end + ts = ts .. ")" + return ts + elseif x == true then + return "#t" + elseif x == false then + return "#f" + else + return tostring(x) + end +end + +function repl.repl (prompt) + prompt = prompt or "lam> " + repeat + io.write(prompt) + io.output():flush() + input = io.read() + if input == ",q" or input == ",quit" then + break + else + val = eval(read(input)) + if val then print(schemestr(val)) end + end + until false +end + +--- +return repl diff --git a/types.lua b/types.lua new file mode 100644 index 0000000..042edce --- /dev/null +++ b/types.lua @@ -0,0 +1,37 @@ +--- lam.types + +local types = {} + +function types.Type(x) + if type(x) == "string" then + -- Symbols are Lua strings + return "Symbol" + elseif type(x) == "number" then + -- Numbers are Lua numbers + return "Number" + elseif x.__type then + return x.__type + elseif type(x) == "table" then + -- Lists are Lua tables (non-adorned) + return "List" + else + return type(x) + end +end + +types.Object = { __type = "Object" } +function types.Object:new(o) + o = o or {} + setmetatable(o, self) + self.__index = self + return o +end + +--- Boxed types + +-- Strings + +-- Lists + +--- +return types diff --git a/util.lua b/util.lua new file mode 100644 index 0000000..98536a1 --- /dev/null +++ b/util.lua @@ -0,0 +1,41 @@ +--- lam.util + +local util = {} + +function util.table (x) + if type(x) == "table" then + return x + else + return { x } + end +end + +function util.pop (tbl) + return table.remove(tbl, 1) +end + +function util.car (tbl) + return tbl[1] +end + +function util.cdr (tbl) + local t = {} + for i = 2, #tbl do t[i-1] = tbl[i] end + return t +end + +function util.reduce (tbl, seed, fn) + if #tbl == 0 then return seed end + return util.reduce(tbl, fn(seed, util.pop(tbl)), fn) +end + +function util.map (fn, tbl) + local out = {} + for k, v in pairs(tbl) do + out[k] = fn(v) + end + return out +end + +--- +return util -- cgit 1.4.1-21-gabe81