1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
--- lam.eval
local eval = {}
local read = require "read"
local util = require "util"
local pp = require "pp"
local global = require "global"
local types = require "types"
table.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, })
end
local function Proc(params, body, env)
local p = {
params = params,
body = body,
env = env,
}
local mt = {
__type = "Procedure",
__call =
function (self, ...)
local inner = {}
for _, p in ipairs(self.params) do
for _, a in ipairs({...}) do
inner[p] = a
end
end
return eval(self.body, Env(inner, self.env))
end,
}
return setmetatable(p, 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
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)
end
return proc(table.unpack(vals))
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
})
|
