Commit | Line | Data |
---|---|---|
86e32f4d JB |
1 | readline = require './node_readline' |
2 | {id, map, each, last, all, unique, zip, Obj, elem-index} = require 'prelude-ls' | |
3 | {read_str} = require './reader' | |
4 | {pr_str} = require './printer' | |
5 | {Env} = require './env' | |
6 | {runtime-error, ns, unpack-tco} = require './core' | |
7 | {list-to-pairs} = require './utils' | |
8 | ||
9 | ||
10 | defer-tco = (env, ast) -> | |
11 | type: \tco | |
12 | env: env | |
13 | ast: ast | |
14 | eval: -> eval_ast env, ast | |
15 | ||
16 | ||
17 | is-thruthy = ({type, value}) -> | |
18 | type != \const or value not in [\nil \false] | |
19 | ||
20 | ||
21 | fmap-ast = (fn, {type, value}: ast) --> | |
22 | {type: type, value: fn value} | |
23 | ||
24 | ||
25 | make-symbol = (name) -> {type: \symbol, value: name} | |
26 | make-list = (value) -> {type: \list, value: value} | |
27 | make-call = (name, params) -> make-list [make-symbol name] ++ params | |
28 | is-symbol = (ast, name) -> ast.type == \symbol and ast.value == name | |
29 | ||
30 | ||
31 | eval_simple = (env, {type, value}: ast) -> | |
32 | switch type | |
33 | | \symbol => env.get value | |
34 | | \list, \vector => ast |> fmap-ast map eval_ast env | |
35 | | \map => ast |> fmap-ast Obj.map eval_ast env | |
36 | | otherwise => ast | |
37 | ||
38 | ||
39 | eval_ast = (env, ast) --> | |
40 | loop | |
41 | if ast.type != \list | |
42 | return eval_simple env, ast | |
43 | ||
44 | ast = macroexpand env, ast | |
45 | if ast.type != \list | |
46 | return eval_simple env, ast | |
47 | else if ast.value.length == 0 | |
48 | return ast | |
49 | ||
50 | result = if ast.value[0].type == \symbol | |
51 | params = ast.value[1 to] | |
52 | switch ast.value[0].value | |
53 | | 'def!' => eval_def env, params | |
54 | | 'let*' => eval_let env, params | |
55 | | 'do' => eval_do env, params | |
56 | | 'if' => eval_if env, params | |
57 | | 'fn*' => eval_fn env, params | |
58 | | 'quote' => eval_quote env, params | |
59 | | 'quasiquote' => eval_quasiquote env, params | |
60 | | 'defmacro!' => eval_defmacro env, params | |
61 | | 'macroexpand' => eval_macroexpand env, params | |
62 | | otherwise => eval_apply env, ast.value | |
63 | else | |
64 | eval_apply env, ast.value | |
65 | ||
66 | if result.type == \tco | |
67 | {env, ast} = result | |
68 | else | |
69 | return result | |
70 | ||
71 | ||
72 | check_params = (name, params, expected) -> | |
73 | if params.length != expected | |
74 | runtime-error "'#{name}' expected #{expected} parameters, | |
75 | got #{params.length}" | |
76 | ||
77 | ||
78 | eval_def = (env, params) -> | |
79 | check_params 'def!', params, 2 | |
80 | ||
81 | # Name is in the first parameter, and is not evaluated. | |
82 | name = params[0] | |
83 | if name.type != \symbol | |
84 | runtime-error "expected a symbol for the first parameter | |
85 | of def!, got a #{name.type}" | |
86 | ||
87 | # Evaluate the second parameter and store | |
88 | # it under name in the env. | |
89 | env.set name.value, (eval_ast env, params[1]) | |
90 | ||
91 | ||
92 | eval_let = (env, params) -> | |
93 | check_params 'let*', params, 2 | |
94 | ||
95 | binding_list = params[0] | |
96 | if binding_list.type not in [\list \vector] | |
97 | runtime-error "expected 1st parameter of 'let*' to | |
98 | be a binding list (or vector), | |
99 | got a #{binding_list.type}" | |
100 | else if binding_list.value.length % 2 != 0 | |
101 | runtime-error "binding list of 'let*' must have an even | |
102 | number of parameters" | |
103 | ||
104 | # Make a new environment with the | |
105 | # current environment as outer. | |
106 | let_env = new Env env | |
107 | ||
108 | # Evaluate all binding values in the | |
109 | # new environment. | |
110 | binding_list.value | |
111 | |> list-to-pairs | |
112 | |> each ([binding_name, binding_value]) -> | |
113 | if binding_name.type != \symbol | |
114 | runtime-error "expected a symbol as binding name, | |
115 | got a #{binding_name.type}" | |
116 | ||
117 | let_env.set binding_name.value, (eval_ast let_env, binding_value) | |
118 | ||
119 | # Defer evaluation of let* body with TCO. | |
120 | defer-tco let_env, params[1] | |
121 | ||
122 | ||
123 | eval_do = (env, params) -> | |
124 | if params.length == 0 | |
125 | runtime-error "'do' expected at least one parameter" | |
126 | ||
127 | [...rest, last-param] = params | |
128 | rest |> each eval_ast env | |
129 | defer-tco env, last-param | |
130 | ||
131 | ||
132 | eval_if = (env, params) -> | |
133 | if params.length < 2 | |
134 | runtime-error "'if' expected at least 2 parameters" | |
135 | else if params.length > 3 | |
136 | runtime-error "'if' expected at most 3 parameters" | |
137 | ||
138 | cond = eval_ast env, params[0] | |
139 | if is-thruthy cond | |
140 | defer-tco env, params[1] | |
141 | else if params.length > 2 | |
142 | defer-tco env, params[2] | |
143 | else | |
144 | {type: \const, value: \nil} | |
145 | ||
146 | ||
147 | eval_fn = (env, params) -> | |
148 | check_params 'fn*', params, 2 | |
149 | ||
150 | if params[0].type not in [\list \vector] | |
151 | runtime-error "'fn*' expected first parameter to be a list or vector." | |
152 | ||
153 | if not all (.type == \symbol), params[0].value | |
154 | runtime-error "'fn*' expected only symbols in the parameters list." | |
155 | ||
156 | binds = params[0].value |> map (.value) | |
157 | vargs = null | |
158 | ||
159 | # Parse variadic bind. | |
160 | if binds.length >= 2 | |
161 | [...rest, amper, name] = binds | |
162 | if amper == '&' and name != '&' | |
163 | binds = rest | |
164 | vargs = name | |
165 | ||
166 | if elem-index '&', binds | |
167 | runtime-error "'fn*' invalid usage of variadic parameters." | |
168 | ||
169 | if (unique binds).length != binds.length | |
170 | runtime-error "'fn*' duplicate symbols in parameters list." | |
171 | ||
172 | body = params[1] | |
173 | ||
174 | fn_instance = (...values) -> | |
175 | if not vargs and values.length != binds.length | |
176 | runtime-error "function expected #{binds.length} parameters, | |
177 | got #{values.length}" | |
178 | else if vargs and values.length < binds.length | |
179 | runtime-error "function expected at least | |
180 | #{binds.length} parameters, | |
181 | got #{values.length}" | |
182 | ||
183 | # Set binds to values in the new env. | |
184 | fn_env = new Env env | |
185 | ||
186 | for [name, value] in (zip binds, values) | |
187 | fn_env.set name, value | |
188 | ||
189 | if vargs | |
190 | fn_env.set vargs, | |
191 | make-list values.slice binds.length | |
192 | ||
193 | # Defer evaluation of the function body to TCO. | |
194 | defer-tco fn_env, body | |
195 | ||
196 | {type: \function, value: fn_instance, is_macro: false} | |
197 | ||
198 | ||
199 | eval_apply = (env, list) -> | |
200 | [fn, ...args] = list |> map eval_ast env | |
201 | if fn.type != \function | |
dd7a4f55 | 202 | runtime-error "#{fn.value} is not a function, got a #{fn.type}" |
86e32f4d JB |
203 | |
204 | fn.value.apply env, args | |
205 | ||
206 | ||
207 | eval_quote = (env, params) -> | |
208 | if params.length != 1 | |
209 | runtime-error "quote expected 1 parameter, got #{params.length}" | |
210 | ||
211 | params[0] | |
212 | ||
213 | ||
214 | is-pair = (ast) -> ast.type in [\list \vector] and ast.value.length != 0 | |
215 | ||
216 | ||
217 | eval_quasiquote = (env, params) -> | |
218 | if params.length != 1 | |
219 | runtime-error "quasiquote expected 1 parameter, got #{params.length}" | |
220 | ||
221 | ast = params[0] | |
222 | new-ast = if not is-pair ast | |
223 | make-call 'quote', [ast] | |
224 | else if is-symbol ast.value[0], 'unquote' | |
225 | ast.value[1] | |
226 | else if is-pair ast.value[0] and \ | |
227 | is-symbol ast.value[0].value[0], 'splice-unquote' | |
228 | make-call 'concat', [ | |
229 | ast.value[0].value[1] | |
230 | make-call 'quasiquote', [make-list ast.value[1 to]] | |
231 | ] | |
232 | else | |
233 | make-call 'cons', [ | |
234 | make-call 'quasiquote', [ast.value[0]] | |
235 | make-call 'quasiquote', [make-list ast.value[1 to]] | |
236 | ] | |
237 | ||
238 | defer-tco env, new-ast | |
239 | ||
240 | ||
241 | eval_defmacro = (env, params) -> | |
242 | check_params 'def!', params, 2 | |
243 | ||
244 | # Name is in the first parameter, and is not evaluated. | |
245 | name = params[0] | |
246 | if name.type != \symbol | |
247 | runtime-error "expected a symbol for the first parameter | |
248 | of defmacro!, got a #{name.type}" | |
249 | ||
250 | # Evaluate the second parameter. | |
251 | fn = eval_ast env, params[1] | |
252 | if fn.type != \function | |
253 | runtime-error "expected a function for the second parameter | |
254 | of defmacro!, got a #{fn.type}" | |
255 | ||
256 | # Copy fn and mark the function as a macro. | |
257 | macro_fn = fn with is_macro: true | |
258 | env.set name.value, macro_fn | |
259 | ||
260 | ||
261 | get-macro-fn = (env, ast) -> | |
262 | if ast.type == \list and | |
263 | ast.value.length != 0 and | |
264 | ast.value[0].type == \symbol | |
265 | fn = env.try-get ast.value[0].value | |
266 | if fn and fn.type == \function and fn.is_macro | |
267 | then fn | |
268 | ||
269 | ||
270 | macroexpand = (env, ast) -> | |
271 | loop # until ast is not a macro function call. | |
272 | macro_fn = get-macro-fn env, ast | |
273 | if not macro_fn then return ast | |
274 | ast = unpack-tco <| macro_fn.value.apply env, ast.value[1 to] | |
275 | ||
276 | ||
277 | eval_macroexpand = (env, params) -> | |
278 | if params.length != 1 | |
279 | runtime-error "'macroexpand' expected 1 parameter, | |
280 | got #{params.length}" | |
281 | ||
282 | macroexpand env, params[0] | |
283 | ||
284 | ||
285 | repl_env = new Env | |
286 | for symbol, value of ns | |
287 | repl_env.set symbol, value | |
288 | ||
289 | # Evil eval. | |
290 | repl_env.set 'eval', do | |
291 | type: \function | |
292 | value: (ast) -> eval_ast repl_env, ast # or use current env? (@ = this). | |
293 | ||
294 | # Read, Evaluate, Print | |
295 | rep = (line) -> | |
296 | line | |
297 | |> read_str | |
298 | |> eval_ast repl_env | |
299 | |> (ast) -> pr_str ast, print_readably=true | |
300 | ||
301 | ||
f4495e1e NB |
302 | # Define not. |
303 | rep '(def! not (fn* (x) (if x false true)))' | |
304 | ||
86e32f4d JB |
305 | # Define load-file. |
306 | rep ' | |
307 | (def! load-file | |
308 | (fn* (f) | |
309 | (eval | |
310 | (read-string | |
311 | (str "(do " (slurp f) ")")))))' | |
312 | ||
b145558e JB |
313 | # Define cond. |
314 | rep ' | |
315 | (defmacro! cond | |
316 | (fn* (& xs) | |
317 | (if (> (count xs) 0) | |
318 | (list \'if (first xs) | |
319 | (if (> (count xs) 1) | |
320 | (nth xs 1) | |
321 | (throw "odd number of forms to cond")) | |
322 | (cons \'cond (rest (rest xs)))))))' | |
323 | ||
324 | # Define or. | |
325 | rep ' | |
326 | (defmacro! or | |
327 | (fn* (& xs) | |
328 | (if (empty? xs) | |
329 | nil | |
330 | (if (= 1 (count xs)) | |
331 | (first xs) | |
332 | `(let* (or_FIXME ~(first xs)) | |
333 | (if or_FIXME or_FIXME (or ~@(rest xs))))))))' | |
86e32f4d JB |
334 | |
335 | # Parse program arguments. | |
336 | # The first two (exe and core-file) are, respectively, | |
337 | # the interpreter executable (nodejs or lsc) and the | |
338 | # source file being executed (stepX_*.(ls|js)). | |
339 | [exe, core-file, mal-file, ...argv] = process.argv | |
340 | ||
341 | repl_env.set '*ARGV*', do | |
342 | type: \list | |
343 | value: argv |> map (arg) -> | |
344 | type: \string | |
345 | value: arg | |
346 | ||
347 | ||
348 | if mal-file | |
349 | rep "(load-file \"#{mal-file}\")" | |
350 | else | |
351 | # REPL. | |
352 | loop | |
353 | line = readline.readline 'user> ' | |
354 | break if not line? or line == '' | |
355 | try | |
356 | console.log rep line | |
dd7a4f55 JM |
357 | catch error |
358 | if error.message | |
359 | then console.error error.message | |
360 | else console.error "Error:", pr_str error, print_readably=true |