--- lam.eval local m = {} local core = require "core" local type = require "type" function m.environ (inner, outer) local mt = { __type = "environment", __index = outer, __newindex = function (self, key, val) if rawget(self, key) then rawset(self, key, val) else getmetatable(self).__index[key] = val end end, } return setmetatable(inner, mt) end function m.procedure (params, body, env) local t = { params = params, body = body, env = env, } local mt = { __type = "procedure", __call = function (self, args) local inner = {} local p, a = self.params, args while p[2] and a[2] do inner[p[1]] = a[1] p, a = p[2], a[2] end local b = self.body local e = m.environ(inner, self.env) while not b[2] == type.null do m.eval(b[1], e) b = b[2] end return m.eval(b[1], e) end, } return setmetatable(t, mt) end local specials = { m.specials = { -- each of these takes R (a list of args) and E (an environment) quote = function (r, e) return r[1] end, define = function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end, lambda = function (r, e) return m.procedure(r[1], r[2], e) end, ["set!"] = function (r, e) e[r[1]] = m.eval(r[2][1], e) end, ["if"] = function (r, e) local test, conseq, alt = r[1], r[2][1], r[2][2][1] if m.eval(test) then return m.eval(conseq) else return m.eval(alt) end end, -- TODO: include, import, define-syntax, ... } -- Aliases m.specials.lam = m.specials.lambda m.specials.def = m.specials.define function m.eval (x, env) local env = env or core.env if type.isa(x, "symbol") then return env[x] elseif not type.islist(x) then return x else local op, args = x[1], x[2] if m.specials[op] then return m.specials[op](args, env) else -- procedure call local fn = m.eval(op, env) local params = {} local r = args while r[2] do table.insert(params, m.eval(r[1], env)) r = r[2] end return fn(type.list(params)) end end end -------- return m