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
|
--- lam.eval
local eval = {}
local read = require "read"
local types = require "types"
local util = require "util"
local pp = require "pp"
Env = types.Object:new {
__type = "Environment",
__extend =
function(self, parms, args, outer)
for _, p in ipairs(parms) do
for _, a in ipairs(args) do
self[p] = a
end
end
getmetatable(self).__index = outer
end,
}
Proc = types.Object:new {
__type = "Procedure",
__call =
function (self, args)
local e = Env:new()
e:__extend(self.parms,
util.table(args),
self.env)
return eval(self.body[1], e)
end
}
global_env = Env:new {
-- 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 types.Type(x) == "Number"
end,
["symbol?"] =
function(x)
return types.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 types.Type(x) == "Symbol" then
return env[x]
elseif types.Type(x) ~= "List" 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 parms = util.car(args)
local body = util.cdr(args)
return Proc:new {
parms = parms,
body = body,
env = env,
}
else -- procedure call
pp(op)
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))))))
-- ]]
|
