--- lam.eval local eval = {} local type = require "type" local isNull, isList, isa, List, Cons = type.isNull, type.isList, type.isa, type.List, type.Cons local unpack = table.unpack or unpack function eval.Env (inner, outer) local mt = { __type = "Environment", __index = outer, } return setmetatable(inner, mt) end function eval.Proc (params, body, env) local v = { params = params, body = body, env = env, } local mt = { __type = "Procedure", __call = function (self, args) local inner = {} 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.eval( self.body, eval.Env(inner, self.env)) end, } return setmetatable(v, mt) end local global = { begin = function (r) local r = r while not isNull(r.cdr) do r = r.cdr end return r.car end, ["+"] = function (r) local r, a = r, 0 while r.cdr do r, a = r.cdr, a + r.car end return a end, ["-"] = function (r) if isNull(r) then return -1 end if isNull(r.cdr) then return (- r.car) end local r, a = r.cdr, r.car while r.cdr do r, a = r.cdr, a - r.car end return a end, } function eval.eval (x, env) env = env or global if isa(x, "Symbol") then return env[x] elseif not isList(x) then return x else local op, args = x.car, x.cdr if op == "quote" then return args.car elseif op == "define" then env[args.car] = eval.eval(args.cdr.car, env) return nil elseif op == "lambda" then return eval.Proc( args.car, Cons("begin", args.cdr), env) elseif op == "if" then assert(not isNull(args.cdr), "Malformed 'if'") local test, conseq, alt = args.car, args.cdr.car, args.cdr.cdr.car if eval.eval(test) then return eval.eval(conseq) else return eval.eval(alt) end 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(List(params)) end end end --- return eval