From a72ff678da253fce46e8e4648f6e4cf5ce1ea9b4 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Sun, 10 Mar 2024 21:39:53 -0500 Subject: uh new start --- Makefile | 20 +++-- eval.lua | 126 ++++++++++++++------------ eval2.lua | 39 -------- global.lua | 162 --------------------------------- list.lua | 48 ---------- port.lua | 20 ----- pp.lua | 26 ++---- read.lua | 297 +++++++++++++++++++++++++++++++------------------------------ repl.lua | 42 --------- test.lua | 28 ++++++ type.lua | 137 ++++++++++++++++++++++++++++ types.lua | 112 ----------------------- util.lua | 33 +------ 13 files changed, 405 insertions(+), 685 deletions(-) delete mode 100644 eval2.lua delete mode 100644 global.lua delete mode 100644 list.lua delete mode 100644 port.lua delete mode 100644 repl.lua create mode 100644 test.lua create mode 100644 type.lua delete mode 100644 types.lua diff --git a/Makefile b/Makefile index ff07d99..54c4f2c 100644 --- a/Makefile +++ b/Makefile @@ -7,12 +7,14 @@ repl: .PHONY: test test: $(LUA) -i \ - -e 'eval=require"eval"'\ - -e 'global=require"global"'\ - -e 'pp=require"pp"'\ - -e 'read=require"read"'\ - -e 'util=require"util"'\ - -e 'repl=require"repl"'\ - -e 'types=require"types"'\ - -e 'utf8=require"utf8"'\ - -e 'util=require"util"' + -e 'pp = require "pp"' \ + -e 'eval = require "eval"' \ + -e 'read = require "read"' \ + -e 'type = require "type"' \ + -e 'utf8 = require "utf8"' \ + -e 'util = require "util"' \ + -e 'test = require "test"' + +.PHONY: check +check: + luacheck *.lua diff --git a/eval.lua b/eval.lua index 806148d..6179842 100644 --- a/eval.lua +++ b/eval.lua @@ -2,21 +2,20 @@ local eval = {} local read = require "read" +local type = require "type" local util = require "util" -local pp = require "pp" -local global = require "global" -local types = require "types" -table.unpack = table.unpack or unpack +local unpack = table.unpack or unpack ---- Environments and Parameters --- these aren't in types.lua to avoid a circular dependency - -local function Env(inner, outer) - return setmetatable(inner, { __type = "Environment", __index = outer, }) +function eval.Env (inner, outer) + local mt = { + __type = "Environment", + __index = outer, + } + return setmetatable(inner, mt) end -local function Proc(params, body, env) - local p = { +function eval.Proc (params, body, env) + local v = { params = params, body = body, env = env, @@ -24,62 +23,77 @@ local function Proc(params, body, env) local mt = { __type = "Procedure", __call = - function (self, ...) + function (self, args) local inner = {} - for _, p in ipairs(self.params) do - for _, a in ipairs({...}) do - inner[p] = a - end + local p, a = self.params, args + while p.cdr and a.cdr do + inner[p.car] = a.car + p, a = p.cdr, a.cdr end - return eval(self.body, Env(inner, self.env)) + -- pp.pp(self.body) + return eval.eval( + self.body, + eval.Env(inner, self.env)) end, } - return setmetatable(p, mt) + return setmetatable(v, mt) end -function eval.eval (x, e) - e = e or global - if types.lamtype(x) == "Symbol" then - return e[x] - elseif types.luatype(x) ~= "table" then +local global = { + begin = + function (args) + local a = args + while not type.isNull(a.cdr) do + a = a.cdr + end + return a.car + end, + ["+"] = + function (args) + local acc = 0 + local car, cdr = args.car, args.cdr + while cdr do + acc = acc + car + car, cdr = cdr.car, cdr.cdr + end + return acc + end, + ["-"] = + function (args) + return args.car - args.cdr.car + end, +} + +function eval.eval (x, env) + env = env or global + if type.isa(x, "Symbol") then + return env[x] + elseif not type.isList(x) then return x else - local op = util.car(x) - local args = util.cdr(x) - if op == types.Symbol("quote") then - return args[1] - elseif op == types.Symbol("define") then - local sym, exp = table.unpack(args) - e[sym] = eval(exp, e) - --[[ - elseif op == "set!" then - local sym, exp = table.unpack(args) - e[sym] = eval(exp, e) --]] - elseif op == types.Symbol("lambda") then - local params = util.car(args) - local body = util.cdr(args) - table.insert(body, 1, "begin") - return Proc(params, - body, - e) - else -- procedure call - local proc = eval(op, e) - local vals = {} - for k, v in pairs(args) do - vals[k] = eval(v, e) + local op, args = x.car, x.cdr + if op == "quote" then + return args + elseif op == "define" then + env[args.car] = eval.eval(args.cdr.car, env) + return nil + elseif op == "lambda" then + return eval.Proc( + args.car, + type.Cons("begin", args.cdr), + env) + else -- procedure + local proc = eval.eval(op, env) + local params = {} + local a = args + while a.cdr do + table.insert(params, eval.eval(a.car, env)) + a = a.cdr end - return proc(table.unpack(vals)) + return proc(type.List(params)) end end end --- -return setmetatable(eval, { __call = - function(_, x, e) - local success, result = - pcall(eval.eval, x, e) - if success then return result - else return ("ERROR: " .. result) - end - end -}) +return eval diff --git a/eval2.lua b/eval2.lua deleted file mode 100644 index 02444b8..0000000 --- a/eval2.lua +++ /dev/null @@ -1,39 +0,0 @@ ---- lam.eval - -local eval = {} -local read = require "read" -local util = require "util" -local types = require "types" -table.unpack = table.unpack or unpack - -local Environment = - function (inner, outer) - -- an Environment is really just a lua table between symbols and - -- values. They can be nested for uh, closure reasons or - -- something. TODO: figure out how this intersects with - -- Namespaces or Symboltables or whatever. - local mt = { - __type = "Environment", - __index = outer, - } - return setmetatable(inner, mt) - end - -local Procedure = - function (params, body, env) - local proc = { - params = params, - body = body, - env = env, - } - local mt = { - __type = "Procedure", - __call = - function (self, ...) - end, - } - return setmetatable(proc, mt) - end - ---- -return eval diff --git a/global.lua b/global.lua deleted file mode 100644 index 1dea773..0000000 --- a/global.lua +++ /dev/null @@ -1,162 +0,0 @@ ---- lam.environment - -local util = require "util" -local types = require "types" -table.unpack = table.unpack or unpack - -local global = { - -- constants ---- TODO this should be at the reader level - ["#t"] = true, - ["#f"] = false, -} - ---- Types --- - -global.luatype = type -global.type = types.lamtype - -global["number?"] = function (x) types.isa(x, "Number") end -global["string?"] = function (x) types.isa(x, "String") end -global["symbol?"] = function (x) types.isa(x, "Symbol") end -global["pair?"] = function (x) types.isa(x, "Pair") end -global["is-a?"] = function (x, t) types.isa(x, t) end - ---- Basic functions --- - -global.car = function (pair) return pair[1] end -global.cdr = function (pair) return pair[2] end - --- global.list = types.List - -global["list?"] = - function (x) - -- TODO : detect circular lists - if type(x) == "table" then - if #x == 0 then return true end - if type(x[2]) ~= "table" then return false end - end - return global["list?"](x[2]) - end - -global["null?"] = function (x) return type(x) == "table" and #x == 0 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.fold = - function (fn, lis) - local out = {} - - return types.List(out) - end - -global["+"] = function (lis) - return - 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/list.lua b/list.lua deleted file mode 100644 index 1153c26..0000000 --- a/list.lua +++ /dev/null @@ -1,48 +0,0 @@ ---- lam.list - -local list = {} -local util = require "util" -local types = require "types" -table.unpack = table.unpack or unpack - -list.Null = setmetatable({}, { - __type = "Null", - __tostring = function(self) return "()" end, -}) - -list.isNull = - function (x) - return x == list.Null - end - -list.List = - function (tbl) - local function tolist (base, items) - if #items == 0 then return base end - return tolist ( - types.Cons(table.remove(items), base), - items - ) - end - return tolist(list.Null, tbl) - end - -list.isList = - function (x) - if list.isNull(x) then - return true - elseif types.isa(x, "Pair") then - return list.isList(x[2]) - else - return false - end - end - -list.fold1 = - function (fn, seed, lis) - if list.isNull(lis) then return seed end - return list.fold1(fn, fn(seed, lis[1]), lis[2]) - end - ---- -return list diff --git a/port.lua b/port.lua deleted file mode 100644 index c5763df..0000000 --- a/port.lua +++ /dev/null @@ -1,20 +0,0 @@ ---- lam.port - -local port = {} -table.unpack = table.unpack or unpack - -function port.Input (file) - return { - file = file, - line = "", - } -end - -port.tokenizer = "%s*(,@|[('`,)]|)" - -function port.Input:tokens () -- iterator - -end - ---- -return port diff --git a/pp.lua b/pp.lua index 9c1a6d0..4d9d9af 100644 --- a/pp.lua +++ b/pp.lua @@ -1,21 +1,8 @@ --- lam.pp local pp = {} -table.unpack = table.unpack or unpack - -pp.luadump = - function (x) - end - -pp.luapp = function (x) print(pp.luadump(x)) end - -pp.lamdump = - function (x) - end - -pp.lampp = function (x) print(pp.lamdump(x)) end - --- The following should be at some point replaced by the preceding +local type = require "type" +local unpack = table.unpack or unpack function pp.dump (x, lvl) lvl = lvl or 0 @@ -23,7 +10,7 @@ function pp.dump (x, lvl) local output = "" --[[if getmetatable(x) and getmetatable(x).__tostring then output = output .. tostring(x) - else]]if type(x) == "table" then + else]]if type.luatype(x) == "table" then local subo = "" for k,v in pairs(x) do if v == x then @@ -46,8 +33,5 @@ function pp.pp (x) print(pp.dump(x)) end -return setmetatable(pp, { __call = - function(_, x) - return pp.pp(x) - end, -}) +--- +return pp diff --git a/read.lua b/read.lua index 00a2d2a..bba4ffa 100644 --- a/read.lua +++ b/read.lua @@ -1,173 +1,182 @@ --- lam.read local read = {} +local type = require "type" local utf8 = require "utf8" -local types = require "types" -table.unpack = table.unpack or unpack - -local string_to_table = - function(str) - local tbl = {} - for p, c in utf8.codes(str) do - table.insert(tbl, c) - end - return tbl - end +local util = require "util" +local unpack = table.unpack or unpack -local consume_whitespace = - function (chars) - local s = {"\\"} -- accumulator for if there's no \n - while chars[1]:match("[ \t]") do - table.insert(s, util.pop(chars)) - end - if chars[1] ~= "\n" then - table.insert(s, chars[1]) - return table.concat(s), chars - end - while chars[1]:match("%s") do - util.pop(chars) - end - return chars[1], chars +function program_characters (program) + local chars = {} + for pos, code in utf8.codes(program) do + table.insert(chars, code) end + return chars +end -local consume_hexvalue = - function (chars) - local u8ch = {} - repeat - local c = util.pop(chars) - table.insert(u8ch,c) - until c == ";" - table.remove(u8ch) -- remove semicolon - return - utf8.char(tonumber(table.concat(u8ch), 16)), - chars +local function consume_string_whitespace (chars) + -- \* * : nothing + local s = {"\\"} + while chars[1]:match("[ \t]") do + table.insert(s, util.pop(chars)) end + if chars[1] ~= "\n" then + table.insert(s, chars[1]) + return table.concat(s), chars + end + while chars[1]:match("%s") do + util.pop(chars) + end + return chars[1], chars +end -local string_bslash = { -- backslash characters - a = "\a", - b = "\b", - t = "\t", - n = "\n", - r = "\r", - ["\""] = "\"", - ["\\"] = "\\", - ["|"] = "|", - -- \* * : nothing - [" "] = consume_whitespace, - ["\t"] = consuem_whitespace, - ["\n"] = consume_whitespace, +local function consume_string_hexvalue (chars) -- \x; : specified character - x = consume_hexvalue, -} + local u8ch = {} + repeat + local c = util.pop(chars) + table.insert(u8ch, c) + until c == ";" + table.remove(u8ch) -- remove semicolon + return utf8.char(tonumber(table.concat(u8ch), 16)), chars +end -local consume_string = - function(chars) - local str = {} - repeat - local c = util.pop(chars) - if c == "\\" then - c = chars[1] - if string_bslash[c] then - if type(string_bslash[c]) == "function" - then - c, chars = - string_bslash[c](chars) - table.insert(str, c) - else - table.insert( - str, - string_bslash[c]) - end +local function consume_string (chars) + local str = {} + local backslash = { + a = "\a", + b = "\b", + t = "\t", + n = "\n", + r = "\r", + ["\""] = "\"", + ["\\"] = "\\", + ["|"] = "|", + [" "] = consume_string_whitespace, + ["\t"] = consume_string_whitespace, + ["\n"] = consume_string_whitespace, + x = consume_string_hexvalue, + } + util.pop(chars) -- throw initial " away + repeat + local c = util.pop(chars) + if c == [[\]] then + c = chars[1] + if backlash[c] then + if type(backslash[c]) == "function" then + c, chars = backslash[c](chars) + table.insert(str, c) else - table.insert(str, "\\"..c) + table.insert(str, backlash[c]) end - util.pop(chars) - elseif c == "\"" then - break else - table.insert(str, c) + table.insert(str, "\\"..c) end - until #chars == 0 - return table.concat(str), chars + util.pop(chars) + elseif c == [["]] then + break + else + table.insert(str, c) + end + until #chars == 0 + return table.concat(str), "string", chars +end + +local function consume_token (chars) + local tok = {} + while chars[1]:match("[^%s()\"#'`,@;]") do + table.insert(tok, util.pop(chars)) end + return table.concat(tok), chars +end -read.tokenize = - function (program) - if not program or program == "" then return nil end - local tokens = {} - local token = "" - local token_type = nil - - local push_token = - function (type, tok) - type = type or token_type - token = tok or token - if token:len() > 0 then - table.insert(tokens, { - type = type, - value = token, }) - token = "" - token_type = nil - end - end +local consume_symbol = consume_token + +local function consume_number (chars) + local digits, chars = consume_token(chars) + local num = tonumber(digits) + if num == nil then error("Bad number: " .. num) end + return num, chars +end + +local function consume_whitespace (chars) + while chars[1]:match("%s") do util.pop(chars) end + return chars +end + +local function consume_comment (chars) + local comment = {} + repeat + table.insert(comment, util.pop(chars)) + until #chars == 0 or chars[1]:match("\n") + return table.concat(comment), "comment", chars +end + +--- API - local chars = string_to_table(program) - while #chars > 0 do - local c = util.pop(chars) - if c == "(" then - push_token() - push_token("begin_list", "(") - elseif c == ")" then - push_token() - push_token("end_list", ")") - elseif c:match("%s") then -- whitespace - push_token() - elseif c == "\"" then -- string - str, chars = consume_string(chars) - push_token("string", str) - elseif c:match("%d") then -- numbers - token = token .. c - token_type = token_type or "number" +read.readtable = { + ["("] = function(chars) return util.pop(chars), "begin_list", chars end, + [")"] = function(chars) return util.pop(chars), "end_list", chars end, + ["\""] = consume_string, + [";"] = consume_comment, + -- ["#"] = + -- ["'"] = + -- ["`"] = + -- [","] = +} + +function read.scan (chars) + local chars = chars + return function() + if #chars == 0 then return nil end + local token, toktype = "", nil + while true do + if read.readtable[chars[1]] then + token, toktype, chars = + read.readtable[chars[1]](chars) + return token, toktype + elseif chars[1]:match("%s") then + chars = consume_whitespace(chars) + elseif chars[1]:match("%d") then + token, chars = consume_number(chars) + return token, "number" else - token = token .. c - token_type = token_type or "symbol" + token, chars = consume_symbol(chars) + return token, "symbol" end end - push_token() - return tokens end +end -read.tokentable = { - string = function (tok) return types.String(tok.value) end, - number = function (tok) return types.Number(tok.value) end, - symbol = function (tok) return types.Symbol(tok.value) end, -} +function read.tokenize (program) + if not program or #program == 0 then return nil end + local tokens = {} + for token, toktype in read.scan(program_characters(program)) do + table.insert(tokens, {type = toktype, value = token}) + end + return tokens +end -read.parse = - function (tokens) - assert(next(tokens), "Unexpected EOF") - tok = util.pop(tokens) - if tok.value == "(" then - local L = {} - while tokens[1].value ~= ")" do - table.insert(L, read.parse(tokens)) - end - util.pop(tokens) -- remove ")" - return types.List(table.unpack(L)) - elseif tok.value == ")" then - error("Unexpected ')'") - elseif read.tokentable[tok.type] then - return read.tokentable[tok.type](tok) - else - error("Bad token: '" .. tok.value .. "'") +function read.parse (tokens) + if not next(tokens) then return nil end + local token = util.pop(tokens) + if token.value == "(" then + local L = {} + while tokens[1].value ~= ")" do + table.insert(L, read.parse(tokens)) end + util.pop(tokens) -- remove the final ")" + return type.List(L) + elseif token.value == ")" then + error("Unexpected ')'") + else + return token.value end +end -read.read = function (program) return read.parse(read.tokenize(program)) end +function read.read (program) + return read.parse(read.tokenize(program)) +end --- -return setmetatable(read, { __call = - function(_, program) - return read.read(program) - end, -}) +return read diff --git a/repl.lua b/repl.lua deleted file mode 100644 index a89fd2c..0000000 --- a/repl.lua +++ /dev/null @@ -1,42 +0,0 @@ ---- lam.repl - -local repl = {} -local eval = require "eval" -local read = require "read" -local util = require "util" -table.unpack = table.unpack or unpack - -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/test.lua b/test.lua new file mode 100644 index 0000000..ce8c034 --- /dev/null +++ b/test.lua @@ -0,0 +1,28 @@ +--- lam.test +-- testing helpers + +local test = {} +local eval = require("eval").eval +local read = require("read").read + +function test.lambda () + local ls = { + [ [[((lambda (x) (+ x x)) 3)]] ] = 6, + [ [[((lambda () 100))]] ] = 100, + [ [[((lambda (x) 1 2 3) 4)]] ] = 3, + [ [[((lambda () 1 2 3))]] ] = 3, + [ [[((lambda (x) x (+ x x) (+ x x x)) 9)]] ] = 27, + } + for l, target in pairs(ls) do + io.write(string.format("%s == %s\n\t", l, target)) + local value = eval(read(l)) + if value == target then + print "ok" + else + print(string.format("not ok : %s", value)) + end + end +end + +--- +return test diff --git a/type.lua b/type.lua new file mode 100644 index 0000000..945f4d1 --- /dev/null +++ b/type.lua @@ -0,0 +1,137 @@ +--- lam.type +-- lisp types + +local t = {} +local util = require "util" +local unpack = table.unpack or unpack + +--- Determining types + +t.luatype = type + +function t.lamtype (x) + if t.luatype(x) == "number" then + return "Number" + elseif t.luatype(x) == "string" then + return "Symbol" + elseif getmetatable(x) and getmetatable(x).__type then + return getmetatable(x).__type + else + return t.luatype(x) + end +end + +-- isa is really only useful on basic types (i.e., not Lists) +function t.isa (x, type) + return t.lamtype(x) == type +end + +--- Creating types + +-- Symbols and Numbers are strings and numbers, respectively. At some point +-- I'll want to implement a full numeric tower and symbol tables or namespaces +-- or whatever, but today is not that day +t.Symbol = tostring +t.Number = tonumber + +-- Strings are (lightly) wrapped +function t.String (str) + local v = { + value = str, + escape = + function (self) + return self.gsub("[\\\"]", "\\%1") + end, + } + local mt = { + __type = "String", + __tostring = + function (self) + return string.format("\"%s\"", self:escape()) + end, + } + return setmetatable(v, mt) +end + +function t.totable (cons) + local out = {} + local car, cdr = cons.car, cons.cdr + while cdr do + table.insert(out, tostring(car)) + if t.luatype(cdr) == "table" then + car = cdr.car + cdr = cdr.cdr + else + table.insert(out, cdr) + break + end + end + return out +end + +-- Conses are Lisp's fundamental collection type +function t.Cons (a, b) + local v = { a, b, } + local mt = { + __type = "Cons", + __index = + function (self, key) + if key == "car" then + return self[1] + elseif key == "cdr" then + return self[2] + end + end, + __tostring = + function (self) + local out = {} + local car, cdr = self.car, self.cdr + while cdr do + table.insert(out, tostring(car)) + if t.luatype(cdr) == "table" then + car = cdr.car + cdr = cdr.cdr + else + table.insert(out, ".") + table.insert(out, cdr) + break + end + end + return "("..table.concat(out, " ")..")" + end, + } + return setmetatable(v, mt) +end + +-- Null is the one value that is both an atom and a list +t.Null = setmetatable({}, { + __type = "Null", + __tostring = function (self) return "()" end, +}) + +function t.isNull (x) + return x == t.Null +end + +-- Lists are chained Conses ending in Null +function t.List (items) + local function tolist (base, items) + if #items == 0 then return base end + return tolist(t.Cons(table.remove(items), base), items) + end + return tolist(t.Null, items) +end + +function t.isList (x) + -- TODO: this does not detect circular lists yet + if t.isNull(x) then + return true + elseif t.isa(x, "Cons") then + return t.isList(x.cdr) + else + return false + end +end + +--- +return t diff --git a/types.lua b/types.lua deleted file mode 100644 index e4813b2..0000000 --- a/types.lua +++ /dev/null @@ -1,112 +0,0 @@ ---- lam.types - -local types = {} -local util = require "util" -table.unpack = table.unpack or unpack - ---- Converting between types - -types.globalns = {} -- namespace - -types.Symbol = - function (name, ns, aliases) - ns = ns or types.globalns - aliases = aliases or {} - if ns[name] then return ns[name] end - local sym = { name = name, aliases = aliases } - ns[name] = sym - for _,a in ipairs(aliases) do - ns[a] = sym - end - local mt = { - __type = "Symbol", - __tostring = function (self) return self.name end, - } - return setmetatable(sym, mt) - end - -types.Number = tonumber - -types.String = - function (str) - local s = { - value = str, - escape = - function(self) - return self:gsub("\"", "\\\"") - end, - } - local mt = { - __type = "String", - __tostring = - function (self) - return string.format( - "\"%s\"", - self:escape()) - end, - } - return setmetatable(s, mt) - end - -types.Cons = - function (a, b) - assert(a ~= nil and b ~= nil, - "Need two non-nil arguments in a pair") - local s = { a, b } - local mt = { - __type = "Pair", - __tostring = - function (p) - local out = {} - local car, cdr = p[1], p[2] - while cdr do - table.insert(out, tostring(car)) - if type(cdr) == "table" then - car = cdr[1] - cdr = cdr[2] - else - table.insert(out, ".") - table.insert(out, cdr) - break - end - end - return "("..table.concat(out, " ")..")" - end - - } - return setmetatable(s, mt) - end - -types.List = - function (tbl) - local function tolist(base, items) - if #items == 0 then return base end - return tolist( - types.Cons(table.remove(items), base), - items) - end - return tolist({}, tbl) - end - ---- Determining types - -types.lamtype = - function (x) - if type(x) == "number" then - return "Number" - elseif getmetatable(x) and getmetatable(x).__type then - return getmetatable(x).__type - else - return type(x) - end - end - ---- Type predicates - -types.isa = - function (x, t) - return types.lamtype(x) == t - end - ---- -return types diff --git a/util.lua b/util.lua index 1059edf..938848c 100644 --- a/util.lua +++ b/util.lua @@ -1,42 +1,11 @@ --- lam.util local util = {} -table.unpack = table.unpack or unpack - -function util.table (x) - if type(x) == "table" then - return x - else - return { x } - end -end +local unpack = table.unpack or unpack 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