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
|
--- lam.eval
local eval = {}
local base = require "base"
local type = require "type"
local isNull, isList, isa, List, Cons =
type.isNull, type.isList, type.isa, type.List, type.Cons
local unpack = table.unpack or unpack
function eval.Env (inner, outer)
local mt = {
__type = "Environment",
__index = outer,
__newindex =
function (self, key, value)
if rawget(self, key) then
-- Set the current environment's value
rawset(self, key, value)
else
-- Set the outer value
getmetatable(self).__index[key] = value
end
end,
}
return setmetatable(inner, mt)
end
function eval.Proc (params, body, env)
local v = {
params = params,
body = body,
env = env,
}
local mt = {
__type = "Procedure",
__call =
function (self, args)
local inner = {}
local p, a = self.params, args
while p.cdr and a.cdr do
inner[p.car] = a.car
p, a = p.cdr, a.cdr
end
local b = self.body
local e = eval.Env(inner, self.env)
while not isNull(b.cdr) do
eval.eval(b.car, e)
b = b.cdr
end
return eval.eval(b.car, e)
end,
}
return setmetatable(v, mt)
end
local specials = {
quote =
function (args, env)
return args.car
end,
define =
function (args, env)
rawset(env, args.car, eval(args.cdr.car, env))
return nil
end,
lambda =
function (args, env)
return Proc(args.car, args.cdr, env)
end,
["set!"] =
function (args, env)
env[args.car] = eval(args.cdr.car, env)
return nil
end,
["if"] =
function (args, env)
local test, conseq, alt =
args.car, args.cdr.car, args.cdr.cdr.car
if eval(test)
then return eval(conseq)
else return eval(alt)
end
end,
-- TODO: include, import, define-syntax, define-values(?) ...
}
-- Aliases
specials.lam = specials.lambda
specials.def = specials.define
function eval.eval (x, env)
env = env or base.env
if isa(x, "Symbol") then
return env[x]
elseif not isList(x) then
return x
else
local op, args = x.car, x.cdr
if specials[op] then
return specials[op](args, env)
else -- procedure
local proc = eval.eval(op, env)
local params = {}
local a = args
while a.cdr do
table.insert(params, eval.eval(a.car, env))
a = a.cdr
end
return proc(List(params))
end
end
end
---
return eval
|
