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
|
--- lam.eval
local m = {}
local type = require("type")
local assert_arity = type.assert_arity
local util = require("util")
local error = util.error
m.primitives = {
quote =
function (r, _)
assert_arity(r,1,1)
return r[1]
end,
quasiquote =
function (r, e)
assert_arity(r,1,1)
local x = r[1]
if not type.listp(x) or type.nullp(x) then
return x
end
local QQ, fin = {}, nil
while x[2] do
if type.listp(x[1]) then
if x[1][1] == "unquote" then
table.insert(QQ,
m.eval(x[1][2][1], e))
elseif x[1][1] == "unquote-splicing"
then
local y = m.eval(x[1][2][1], e)
if not type.listp(y) then
fin = y
break
end
while y[2] do
table.insert(QQ, y[1])
y = y[2]
end
end
else
table.insert(QQ, x[1])
end
x = x[2]
end
return type.list(QQ, fin)
end,
unquote =
function (_, _)
error("unexpected", ",")
end,
["unquote-splicing"] =
function (_, _)
error("unexpected", ",@")
end,
define =
function (r, e)
assert_arity(r,2,2)
rawset(e, r[1], m.eval(r[2][1], e))
end,
["set!"] =
function (r, e)
assert_arity(r,2,2)
e[r[1]] = m.eval(r[2][1], e)
end,
lambda =
function (r, e)
assert_arity(r,2)
return type.procedure(r[1], r[2], e, m.eval)
end,
["if"] =
function (r, e)
assert_arity(r,2,3)
local test, conseq, alt = r[1], r[2][1], r[2][2][1]
if m.eval(test, e)
then return m.eval(conseq, e)
else return m.eval(alt, e)
end
end,
-- TODO: include, import, define-syntax ...
}
function m.eval (x, env)
if type.isp(x, "symbol") then
if env[x] == nil then
error("unbound symbol", x)
end
return env[x]
elseif not type.listp(x) then
return x
else
local op, args = x[1], x[2]
if m.primitives[op] then
return m.primitives[op](args, env)
else -- procedure application
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
|
