Created
December 30, 2013 14:48
-
-
Save fnuecke/8182925 to your computer and use it in GitHub Desktop.
https://code.google.com/p/lualisp/ amalgamated and ported for Lua 5.2 and adjusted to run in OpenComputers (meaning it uses some OpenComputers specific functions)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- This software is licensed under the M.I.T. license. | |
-- Author: David Bergman | |
-- | |
-- This is a Scheme/Lisp interpreter, written in Lua. | |
-- Adjusted for Lua 5.2 and amalgamated for OpenComputers. | |
-- Run it without parameters to get into interpreter mode. | |
-- Alternatively pass it a file name of a lisp script. | |
local environment = {} | |
-- Lookup a symbol, going from the most local to the most global scope. | |
function environment:lookup(symbol) | |
for i = self.scopeCount, 1, -1 do | |
local tab = self.scopes[i] | |
local val = tab[symbol] | |
if val then | |
return val | |
end | |
end | |
return nil | |
end | |
-- Add a new key or change an existing one in the most local scope. | |
function environment:add(key, value) | |
self.scopes[self.scopeCount][key] = value | |
return self.scopes[self.scopeCount][key] | |
end | |
-- Create a string representation of the environment. | |
function environment:tostring() | |
local str = {} | |
table.insert(str, "Environment[scopeCount=" .. self.scopeCount .. "\n") | |
for _, scope in ipairs(self.scopes) do | |
table.insert(str, "Scope[") | |
for k, v in pairs(scope) do | |
table.insert(str, tostring(k)) | |
table.insert(str, "=") | |
table.insert(str, tostring(v)) | |
table.insert(str, " ") | |
end | |
table.insert(str, "]\n") | |
end | |
table.insert(str, "]") | |
return table.concat(str) | |
end | |
function environment:addBindings(formalList, actualList) | |
return self:addLocalScope(environment.bind({}, formalList, actualList)) | |
end | |
function environment.bind(scope, formalList, actualList) | |
if formalList.type == "CONS" then | |
scope[formalList.car.lexeme] = actualList.car | |
return environment.bind(scope, formalList.cdr, actualList.cdr) | |
else | |
return scope | |
end | |
end | |
-- Create local scope and return new extended environment. | |
function environment:addLocalScope(localScope) | |
-- Add a new empty local scope. | |
local newScopes = {} | |
for _, scope in ipairs(self.scopes) do | |
table.insert(newScopes, scope) | |
end | |
table.insert(newScopes, localScope) | |
return setmetatable({ | |
scopeCount = self.scopeCount + 1, | |
scopes = newScopes, | |
add = environment.add, | |
addBindings = environment.addBindins, | |
addLocalScope = environment.addLocalScope | |
}, environment.mt) | |
end | |
environment.mt = { | |
__index = environment.lookup, | |
__newindex = environment.add, | |
__tostring = environment.tostring | |
} | |
function environment.new(scope) | |
-- The scopes are stored from most global to most local. | |
return setmetatable({ | |
scopeCount = 1, | |
scopes = {scope}, | |
add = environment.add, | |
addBindings = environment.addBindings, | |
addLocalScope = environment.addLocalScope, | |
lookup = environment.lookup | |
}, environment.mt) | |
end | |
-- Deals with (unevaluated or not) S-expressions, which are simply atoms or CONS cells. | |
-- The atoms are either: | |
-- 1. Literals (t or nil) | |
-- 2. Numericals | |
-- 3. Operators [',`] | |
-- 4. Symbols | |
-- 5. Function references | |
local Sexpr = {} | |
Sexpr.constants = {["t"]=true, ["nil"]=true} | |
Sexpr.mt = {} | |
function Sexpr.mt.__tostring(expr) | |
if expr.type == "CONS" then | |
return "(" .. tostring(expr.car) .. " . " .. tostring(expr.cdr) .. ")" | |
else | |
return "atom[type=" .. expr.type .. ", lex=\"" .. expr.lexeme .. "\"]" | |
end | |
end | |
-- Atoms | |
function Sexpr.newBool(cond) | |
if cond then | |
return Sexpr.newAtom("t") | |
else | |
return Sexpr.newAtom("nil") | |
end | |
end | |
function Sexpr.newString(content) | |
return setmetatable({type="STR", lexeme=content}, Sexpr.mt) | |
end | |
function Sexpr.newOperator(op) | |
local type | |
if op == "(" then | |
type = "LEFTPAREN" | |
elseif op == ")" then | |
type = "RIGHTPAREN" | |
else | |
type = "OP" | |
end | |
return setmetatable({type=type, lexeme=op}, Sexpr.mt) | |
end | |
function Sexpr.newAtom(atom) | |
-- Make sure to use the string from here on | |
atom = tostring(atom) | |
local expr | |
if Sexpr.constants[atom] then | |
expr = {type="LITERAL", lexeme=atom} | |
elseif string.find(atom, "^%d+$") then | |
expr = {type="NUM", lexeme=atom} | |
else | |
expr = {type="SYM", lexeme=atom} | |
end | |
return setmetatable(expr, Sexpr.mt) | |
end | |
-- Create a new function reference, where the special parameter can be nil | |
-- (for a normal function) or 'lazy' for functions handling their own internal | |
-- evaluation, or 'macro' for functions mereley replacing their body, for | |
-- further evaluation. | |
function Sexpr.newFun(name, fun, special) | |
return {type="FUN", lexeme=name, fun=fun, special=special} | |
end | |
function Sexpr.cons(a, b) | |
return setmetatable({type="CONS", car=a, cdr=b} , Sexpr.mt) | |
end | |
function Sexpr.prettyPrint(sexpr, inList) | |
local pretty | |
if sexpr.type == "CONS" then | |
local str = {} | |
-- If we are inside a list, we skip the initial '('. | |
if inList then | |
table.insert(str, " ") | |
else | |
table.insert(str, "(") | |
end | |
table.insert(str, Sexpr.prettyPrint(sexpr.car)) | |
-- Pretty print the CDR part in list mode. | |
table.insert(str, Sexpr.prettyPrint(sexpr.cdr, true)) | |
-- Close with a ')' if we were not in a list mode already. | |
if not inList then | |
table.insert(str, ")") | |
end | |
pretty = table.concat(str) | |
else | |
local str = {} | |
if inList and | |
(sexpr.type ~= "LITERAL" or sexpr.lexeme ~= "nil") then | |
table.insert(str, " . ") | |
end | |
if sexpr.type == "FUN" then | |
if sexpr.special == "macro" then | |
table.insert(str, "#macro'") | |
else | |
table.insert(str, "#'") | |
end | |
end | |
-- We just add the lexeme, unless we are a nil in the end of a list... | |
if not inList or sexpr.type ~= "LITERAL" or sexpr.lexeme ~= "nil" then | |
if sexpr.type == "STR" then | |
table.insert(str, "\"") | |
end | |
table.insert(str, sexpr.lexeme) | |
if sexpr.type == "STR" then | |
table.insert(str, "\"") | |
end | |
end | |
pretty = table.concat(str) | |
end | |
return pretty | |
end | |
parser = { | |
operators = { | |
["("] = true, [")"] = true, | |
[","] = true, ["'"] = true, | |
["`"] = true, ["."] = true | |
} | |
} | |
-- Parse the code snippet, yielding a list of (unevaluated) S-expr. | |
function parser.parseSexpr(expr) | |
local tokenList = parser.parseTokens(expr) | |
local next = 1 | |
local sexpr | |
local sexprList = {} | |
repeat | |
next, sexpr = parser.createSexpr(tokenList, next) | |
if sexpr then | |
table.insert(sexprList, sexpr) | |
end | |
until not sexpr | |
return sexprList | |
end | |
function parser.createSexpr(tokens, start) | |
-- If the first token is a '(', we should expect a "list". | |
local firstToken = tokens[start] | |
if not firstToken then | |
return start, nil | |
end | |
if firstToken.type == "LEFTPAREN" then | |
return parser.createCons(tokens, start + 1) | |
elseif firstToken.type == "OP" then | |
local next, cdr = parser.createSexpr(tokens, start + 1) | |
return next, Sexpr.cons(firstToken, cdr) | |
else | |
return start + 1, firstToken | |
end | |
end | |
function parser.createCons(tokens, start) | |
-- If the first token is a '.', we just return the second token, as is, | |
-- while skipping a subsequent ')', else if it is a ')' we return NIL, | |
-- else we get the first Sexpr and CONS it with the rest. | |
local firstTok = tokens[start] | |
if not firstTok then | |
error("Token index " .. start .. " is out of range when creating CONS S-Expr", 2) | |
end | |
if firstTok.type == "OP" and firstTok.lexeme == "." then | |
-- We skip the last ')'. | |
local next, cdr = parser.createSexpr(tokens, start + 1) | |
if not tokens[next] or tokens[next].type ~= "RIGHTPAREN" then | |
error("The CDR part ending with " .. tokens[next - 1].lexeme .. " was not followed by a ')'") | |
end | |
return next + 1, cdr | |
elseif firstTok.type == "RIGHTPAREN" then | |
return start + 1, Sexpr.newAtom("nil") | |
else | |
local next, car = parser.createSexpr(tokens, start) | |
local rest, cdr = parser.createCons(tokens, next) | |
return rest, Sexpr.cons(car, cdr) | |
end | |
end | |
-- Parse a sub expression, returning both an expression and | |
-- the index following this sub expression. | |
function parser.parseTokens(expr) | |
tokens = {} | |
-- We do it character by character, using queues to | |
-- handle strings as well as regular lexemes | |
local currentToken = {} | |
local inString = false | |
local isEscaping = false | |
for i = 1, string.len(expr) do | |
local c = string.sub(expr, i, i) | |
-- We have seven (7) main cases: | |
if isEscaping then | |
-- 1. Escaping this character, whether in a string or not. | |
table.insert(currentToken, c) | |
isEscaping = false | |
elseif c == "\\" then | |
-- 2. An escape character | |
isEscaping = true | |
elseif c == "\"" then | |
-- 3. A quotation mark | |
if not inString then | |
-- a. starting a new string | |
-- If we already had a token, let us finish that up first | |
if #currentToken > 0 then | |
table.insert(tokens, Sexpr.newAtom(table.concat(currentToken))) | |
end | |
currentToken = {} | |
inString = true | |
else | |
-- b. ending a string | |
table.insert(tokens, Sexpr.newString(table.concat(currentToken))) | |
currentToken = {} | |
inString = false | |
end | |
elseif inString then | |
-- 4. inside a string, so just add the character | |
table.insert(currentToken, c) | |
elseif parser.operators[c] then | |
-- 5. special operator (and not inside string) | |
-- We add any saved token | |
if #currentToken > 0 then | |
table.insert(tokens, Sexpr.newAtom(table.concat(currentToken))) | |
currentToken = {} | |
end | |
table.insert(tokens, Sexpr.newOperator(c)) | |
elseif string.find(c, "%s") then | |
-- 6. A blank character, which should add the current token, if any. | |
if #currentToken > 0 then | |
table.insert(tokens, Sexpr.newAtom(table.concat(currentToken))) | |
currentToken = {} | |
end | |
else | |
-- 7. A non-blank character being part of the a symbol | |
table.insert(currentToken, c) | |
end | |
end | |
-- Add any trailing token... | |
if #currentToken > 0 then | |
local atom | |
if inString then | |
atom = Sexpr.newString(table.concat(currentToken)) | |
else | |
atom = Sexpr.newAtom(table.concat(currentToken)) | |
end | |
table.insert(tokens, atom) | |
end | |
return tokens | |
end | |
local lisp = {} | |
function lisp.evalExpr(env, expr) | |
return lisp.evalSexprList(env, parser.parseSexpr(expr)) | |
end | |
function lisp.evalQuote(env, sexpr) | |
local value | |
if not sexpr.type then | |
error("Invalid S-expr: ", 2) | |
end | |
if sexpr.type == "CONS" then | |
local car = sexpr.car | |
if car.type == "OP" and car.lexeme == "," then | |
value = lisp.evalSexpr(env, sexpr.cdr) | |
else | |
local evalCar = lisp.evalQuote(env, car) | |
local cdr = lisp.evalQuote(env, sexpr.cdr) | |
value = Sexpr.cons(evalCar, cdr) | |
end | |
else | |
value = sexpr | |
end | |
return value | |
end | |
function lisp.evalSexprList(env, sexprList, index) | |
if not index then | |
index = 1 | |
end | |
local count = #sexprList | |
if index > count then | |
return nil | |
else | |
local firstValue = lisp.evalSexpr(env, sexprList[index]) | |
if index == count then | |
return firstValue | |
else | |
return lisp.evalSexprList(env, sexprList, index + 1) | |
end | |
end | |
end | |
function lisp.evalSexpr(env, sexpr) | |
local value | |
if not sexpr.type then | |
error("Invalid S-expr: " .. sexpr, 2) | |
end | |
if sexpr.type == "CONS" then | |
-- 1. Cons cell | |
local car = sexpr.car | |
if car.type == "OP" and car.lexeme == "'" then | |
value = sexpr.cdr | |
elseif car.type == "OP" and car.lexeme == "`" then | |
value = lisp.evalQuote(env, sexpr.cdr) | |
else | |
local fun = lisp.evalSexpr(env, car) | |
if not fun or fun.type ~= "FUN" then | |
error("The S-expr did not evaluate to a function: " .. tostring(car)) | |
end | |
-- The function can be eithe "lazy", in that it deals with | |
-- evaluation of its arguments itself, a "macro", which requires | |
-- a second evaluation after the macro expansion, or | |
-- a regular eager one | |
local args | |
if fun.special == "lazy" or fun.special == "macro" then | |
args = sexpr.cdr | |
else | |
args = lisp.evalList(env, sexpr.cdr) | |
end | |
value = fun.fun(env, args) | |
end | |
elseif sexpr.type == "SYM" then | |
-- a. symbol | |
value = env[sexpr.lexeme] | |
if not value then | |
error("The symbol '" .. sexpr.lexeme .. "' is not defined") | |
end | |
else | |
-- b. constant | |
value = sexpr | |
end | |
return value | |
end | |
-- Evaluate each item in a list | |
function lisp.evalList(env, list) | |
if list.type == "CONS" then | |
return Sexpr.cons(lisp.evalSexpr(env, list.car), | |
lisp.evalList(env, list.cdr)) | |
else | |
return list | |
end | |
end | |
-- Apply an environment and get the substituted S-exp | |
function lisp.applyEnv(env, expr) | |
if expr.type == "CONS" then | |
return Sexpr.cons(lisp.applyEnv(env, expr.car), | |
lisp.applyEnv(env, expr.cdr)) | |
elseif expr.type == "SYM" then | |
return env[expr.lexeme] or expr | |
else | |
return expr | |
end | |
end | |
-- Some primitives | |
function lisp.prim_car(env, args) | |
return args.car.car | |
end | |
function lisp.prim_cdr(env, args) | |
return args.car.cdr | |
end | |
function lisp.prim_cons(env, args) | |
return Sexpr.cons(args.car, args.cdr.car) | |
end | |
function lisp.prim_plus(env, args) | |
return Sexpr.newAtom(tonumber(args.car.lexeme) + tonumber(args.cdr.car.lexeme)) | |
end | |
function lisp.prim_mult(env, args) | |
return Sexpr.newAtom(tonumber(args.car.lexeme) * tonumber(args.cdr.car.lexeme)) | |
end | |
function lisp.prim_lambda(env, args) | |
local formalParams = args.car | |
local body = args.cdr.car | |
return Sexpr.newFun("(lambda " .. | |
Sexpr.prettyPrint(formalParams) .. | |
" " .. Sexpr.prettyPrint(body) .. ")", | |
function(env2, actualParams) | |
local localEnv = env:addBindings(formalParams, actualParams) | |
return lisp.evalSexpr(localEnv, body) | |
end) | |
end | |
function lisp.prim_if(env, args) | |
local cond = lisp.evalSexpr(env, args.car) | |
if cond.type == "LITERAL" and cond.lexeme == "nil" then | |
return lisp.evalSexpr(env, args.cdr.cdr.car) | |
else | |
return lisp.evalSexpr(env, args.cdr.car) | |
end | |
end | |
function lisp.prim_eq(env, args) | |
local arg1 = args.car | |
local arg2 = args.cdr.car | |
return Sexpr.newBool(arg1.type == arg2.type and arg1.type ~= "CONS" and arg1.lexeme == arg2.lexeme) | |
end | |
function lisp.prim_lt(env, args) | |
return Sexpr.newBool(tonumber(args.car.lexeme) < tonumber(args.cdr.car.lexeme)) | |
end | |
function lisp.prim_consp(env, args) | |
return Sexpr.newBool(args.car.type == "CONS") | |
end | |
function lisp.prim_neg(env, args) | |
return Sexpr.newAtom(-args.car.lexeme) | |
end | |
function lisp.prim_setq(env, args) | |
local value = lisp.evalSexpr(env, args.cdr.car) | |
env[args.car.lexeme] = value | |
return value | |
end | |
function lisp.prim_eval(env, sexpr) | |
local car = sexpr.car | |
if car.type == "STR" then | |
return lisp.evalExpr(env, car.lexeme) | |
else | |
return lisp.evalSexpr(env, car) | |
end | |
end | |
function lisp.prim_load(env, sexpr) | |
lisp.runFile(env, sexpr.car.lexeme) | |
return Sexpr.newBool(true) | |
end | |
function lisp.prim_echo(env, sexpr) | |
print(Sexpr.prettyPrint(sexpr.car)) | |
return Sexpr.newBool(true) | |
end | |
function lisp.prim_defmacro(env, sexpr) | |
local name = sexpr.car | |
local params = sexpr.cdr.car | |
local body = sexpr.cdr.cdr.car | |
local fun = Sexpr.newFun("(defmacro " .. name.lexeme .. | |
" " .. Sexpr.prettyPrint(params) .. | |
" " .. Sexpr.prettyPrint(body) .. | |
")", function (env, e) | |
return lisp.evalSexpr(env, lisp.applyEnv(environment.new(environment.bind({}, params, e)), body)) | |
end, "macro") | |
env[name.lexeme] = fun | |
return fun | |
end | |
function lisp.getPrimitiveScope() | |
return { | |
["car"] = Sexpr.newFun("car", lisp.prim_car), | |
["cdr"] = Sexpr.newFun("cdr", lisp.prim_cdr), | |
["cons"] = Sexpr.newFun("cons", lisp.prim_cons), | |
["lambda"] = Sexpr.newFun("lambda", lisp.prim_lambda, "lazy"), | |
["setq"] = Sexpr.newFun("setq", lisp.prim_setq, "lazy"), | |
["<"] = Sexpr.newFun("<", lisp.prim_lt), | |
["+"] = Sexpr.newFun("+", lisp.prim_plus), | |
["*"] = Sexpr.newFun("*", lisp.prim_mult), | |
["neg"] = Sexpr.newFun("neg", lisp.prim_neg), | |
["eq"] = Sexpr.newFun("eq", lisp.prim_eq), | |
["consp"] = Sexpr.newFun("consp", lisp.prim_consp), | |
["eval"] = Sexpr.newFun("eval", lisp.prim_eval), | |
["load"] = Sexpr.newFun("load", lisp.prim_load), | |
["echo"] = Sexpr.newFun("echo", lisp.prim_echo), | |
["defmacro"] = Sexpr.newFun("defmacro", lisp.prim_defmacro, "lazy"), | |
["if"] = Sexpr.newFun("if", lisp.prim_if, "lazy") | |
} | |
end | |
function lisp.getGlobalEnv() | |
local env = environment.new(lisp.getPrimitiveScope()) | |
lisp.evalExpr(env, [[ | |
(defmacro defun (name params body) | |
(setq name (lambda params body))) | |
(defmacro or (a b) | |
(if a a b)) | |
(defmacro and (a b) | |
(if a b nil)) | |
(defun <= (x y) | |
(or (< x y) (eq x y))) | |
(defun > (x y) | |
(< y x)) | |
(defun >= (x y) | |
(<= y x)) | |
(defun - (x y) | |
(+ x (neg y)))) | |
(defun nullp (x) | |
(eq x nil)) | |
]]) | |
return env | |
end | |
function lisp.runFile(env, filename) | |
local f, reason = io.open(filename, "r") | |
if not f then | |
error(reason) | |
end | |
local code = f:read("*all") | |
f:close() | |
return lisp.evalExpr(env, code) | |
end | |
function lisp.readEval() | |
local history = {} | |
local env = lisp.getGlobalEnv() | |
while term.isAvailable() do | |
local foreground = component.gpu.setForeground(0x00FF00) | |
term.write("lisp> ") | |
component.gpu.setForeground(foreground) | |
local code = term.read(history) | |
if code == nil then | |
return | |
end | |
while #history > 10 do | |
table.remove(history, 1) | |
end | |
if code then | |
local result = table.pack(pcall(lisp.evalExpr, env, code)) | |
if not result[1] or result.n > 1 then | |
for i = 2, result.n do | |
if result[i] then | |
result[i] = Sexpr.prettyPrint(result[i]) | |
end | |
end | |
print(table.unpack(result, 2, result.n)) | |
end | |
end | |
end | |
end | |
local args = shell.parse(...) | |
if #args > 0 then | |
lisp.runFile(lisp.getGlobalEnv(), shell.resolve(args[1])) | |
else | |
lisp.readEval() | |
end |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment