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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
--- lam.eval
local eval = {}
local read = require "read"
local util = require "util"
local pp = require "pp"
local function Type (x)
if type(x) == "string" then
return "Symbol"
elseif type(x) == "number" then
return "Number"
elseif getmetatable(x) and getmetatable(x).__type then
return x.__type
elseif type(x) == "table" then
return "List"
else
return type(x)
end
end
local Symbol = tostring
local Number = tonumber
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
local global_env = {
-- constants
["#t"] = true,
["#f"] = false,
-- basic math
["+"] =
function (...)
print(...)
return util.reduce(
{...}, 0,
function (a, b) return a + b end)
end,
["*"] =
function (...)
return util.reduce(
{...}, 1,
function (a, b) return a * b end)
end,
-- scheme predicates
["null?"] =
function(x)
return x == {}
end,
["number?"] =
function(x)
return Type(x) == "Number"
end,
["symbol?"] =
function(x)
return Type(x) == "Symbol"
end,
-- scheme functions
["apply"] =
function(fn, ...)
local args = {...}
local last = args[#args]
assert(type(last)=="table", "Bad apply")
table.remove(args)
for _,v in ipairs(last) do
table.insert(args, v)
end
return fn(table.unpack(args))
end,
["begin"] =
function(...)
local xs = {...}
return xs[#xs]
end,
["map"] =
function(fn, ...)
return util.map(fn, {...})
end,
["car"] = util.car,
["cdr"] = util.cdr,
["list"] = function(...) return {...} end,
}
-- Math
for k, v in pairs(math) do
global_env[k] = v
end
function eval.eval (x, env)
env = env or global_env
if Type(x) == "Symbol" then
return env[x]
elseif type(x) ~= "table" then
return x
else
local op = util.car(x)
local args = util.cdr(x)
if op == "quote" then
return args[1]
elseif op == "define" then
local sym, exp = table.unpack(args)
env[sym] = eval(exp, env)
--[[
elseif op == "set!" then
local sym, exp = table.unpack(args)
env[sym] = eval(exp, env) --]]
elseif op == "lambda" then
local params = util.car(args)
local body = util.cdr(args)[1]
return Proc(params, body, env)
else -- procedure call
local proc = eval(op, env)
local vals = util.map(
function(v) return eval(v, env) end,
args)
return proc(table.unpack(vals))
end
end
end
---
return setmetatable(eval, { __call =
function(_, x, env)
local success, result =
pcall(eval.eval, x, env)
if success then return result
else return ("ERROR: " .. result)
end
end
})
--[[
(begin (define sq (lambda (x) (* x x))) (define rep (lambda (f) (lambda (x) (f (f x))))))
-- ]]
|
