diff options
Diffstat (limited to 'eval.lua')
-rw-r--r-- | eval.lua | 145 |
1 files changed, 145 insertions, 0 deletions
diff --git a/eval.lua b/eval.lua new file mode 100644 index 0000000..3decded --- /dev/null +++ b/eval.lua | |||
@@ -0,0 +1,145 @@ | |||
1 | --- lam.eval | ||
2 | |||
3 | local eval = {} | ||
4 | local read = require "read" | ||
5 | local types = require "types" | ||
6 | local util = require "util" | ||
7 | local pp = require "pp" | ||
8 | |||
9 | Env = types.Object:new { | ||
10 | __type = "Environment", | ||
11 | __extend = | ||
12 | function(self, parms, args, outer) | ||
13 | for _, p in ipairs(parms) do | ||
14 | for _, a in ipairs(args) do | ||
15 | self[p] = a | ||
16 | end | ||
17 | end | ||
18 | getmetatable(self).__index = outer | ||
19 | end, | ||
20 | } | ||
21 | |||
22 | Proc = types.Object:new { | ||
23 | __type = "Procedure", | ||
24 | __call = | ||
25 | function (self, args) | ||
26 | local e = Env:new() | ||
27 | e:__extend(self.parms, | ||
28 | util.table(args), | ||
29 | self.env) | ||
30 | return eval(self.body[1], e) | ||
31 | end | ||
32 | } | ||
33 | |||
34 | global_env = Env:new { | ||
35 | -- constants | ||
36 | ["#t"] = true, | ||
37 | ["#f"] = false, | ||
38 | -- basic math | ||
39 | ["+"] = | ||
40 | function (...) | ||
41 | print(...) | ||
42 | return util.reduce( | ||
43 | {...}, 0, | ||
44 | function (a, b) return a + b end) | ||
45 | end, | ||
46 | ["*"] = | ||
47 | function (...) | ||
48 | return util.reduce( | ||
49 | {...}, 1, | ||
50 | function (a, b) return a * b end) | ||
51 | end, | ||
52 | -- scheme predicates | ||
53 | ["null?"] = | ||
54 | function(x) | ||
55 | return x == {} | ||
56 | end, | ||
57 | ["number?"] = | ||
58 | function(x) | ||
59 | return types.Type(x) == "Number" | ||
60 | end, | ||
61 | ["symbol?"] = | ||
62 | function(x) | ||
63 | return types.Type(x) == "Symbol" | ||
64 | end, | ||
65 | -- scheme functions | ||
66 | ["apply"] = | ||
67 | function(fn, ...) | ||
68 | local args = {...} | ||
69 | local last = args[#args] | ||
70 | assert(type(last)=="table", "Bad apply") | ||
71 | table.remove(args) | ||
72 | for _,v in ipairs(last) do | ||
73 | table.insert(args, v) | ||
74 | end | ||
75 | return fn(table.unpack(args)) | ||
76 | end, | ||
77 | ["begin"] = | ||
78 | function(...) | ||
79 | local xs = {...} | ||
80 | return xs[#xs] | ||
81 | end, | ||
82 | ["map"] = | ||
83 | function(fn, ...) | ||
84 | return util.map(fn, {...}) | ||
85 | end, | ||
86 | ["car"] = util.car, | ||
87 | ["cdr"] = util.cdr, | ||
88 | ["list"] = function(...) return {...} end, | ||
89 | } | ||
90 | |||
91 | -- Math | ||
92 | for k, v in pairs(math) do | ||
93 | global_env[k] = v | ||
94 | end | ||
95 | |||
96 | function eval.eval (x, env) | ||
97 | env = env or global_env | ||
98 | if types.Type(x) == "Symbol" then | ||
99 | return env[x] | ||
100 | elseif types.Type(x) ~= "List" then | ||
101 | return x | ||
102 | else | ||
103 | local op = util.car(x) | ||
104 | local args = util.cdr(x) | ||
105 | if op == "quote" then | ||
106 | return args[1] | ||
107 | elseif op == "define" then | ||
108 | local sym, exp = table.unpack(args) | ||
109 | env[sym] = eval(exp, env) | ||
110 | elseif op == "set!" then | ||
111 | local sym, exp = table.unpack(args) | ||
112 | env[sym] = eval(exp, env) | ||
113 | elseif op == "lambda" then | ||
114 | local parms = util.car(args) | ||
115 | local body = util.cdr(args) | ||
116 | return Proc:new { | ||
117 | parms = parms, | ||
118 | body = body, | ||
119 | env = env, | ||
120 | } | ||
121 | else -- procedure call | ||
122 | pp(op) | ||
123 | local proc = eval(op, env) | ||
124 | local vals = util.map( | ||
125 | function(v) return eval(v, env) end, | ||
126 | args) | ||
127 | return proc(table.unpack(vals)) | ||
128 | end | ||
129 | end | ||
130 | end | ||
131 | |||
132 | --- | ||
133 | return setmetatable(eval, { __call = | ||
134 | function(_, x, env) | ||
135 | local success, result = | ||
136 | pcall(eval.eval, x, env) | ||
137 | if success then return result | ||
138 | else return ("ERROR: " .. result) | ||
139 | end | ||
140 | end | ||
141 | }) | ||
142 | |||
143 | --[[ | ||
144 | (begin (define sq (lambda (x) (* x x))) (define rep (lambda (f) (lambda (x) (f (f x)))))) | ||
145 | -- ]] | ||