Commit | Line | Data |
---|---|---|
31690700 JM |
1 | #include <stdlib.h> |
2 | #include <stdio.h> | |
3 | #include <unistd.h> | |
8cb5cda4 | 4 | |
31690700 JM |
5 | #include "types.h" |
6 | #include "readline.h" | |
7 | #include "reader.h" | |
ea81a808 | 8 | #include "core.h" |
31690700 JM |
9 | #include "interop.h" |
10 | ||
11 | // Declarations | |
12 | MalVal *EVAL(MalVal *ast, Env *env); | |
13 | MalVal *macroexpand(MalVal *ast, Env *env); | |
14 | ||
15 | // read | |
16 | MalVal *READ(char prompt[], char *str) { | |
17 | char *line; | |
18 | MalVal *ast; | |
19 | if (str) { | |
20 | line = str; | |
21 | } else { | |
22 | line = _readline(prompt); | |
23 | if (!line) { | |
24 | _error("EOF"); | |
25 | return NULL; | |
26 | } | |
27 | } | |
28 | ast = read_str(line); | |
29 | if (!str) { free(line); } | |
30 | return ast; | |
31 | } | |
32 | ||
33 | // eval | |
34 | int is_pair(MalVal *x) { | |
35 | return _sequential_Q(x) && (_count(x) > 0); | |
36 | } | |
37 | ||
38 | MalVal *quasiquote(MalVal *ast) { | |
39 | if (!is_pair(ast)) { | |
ea81a808 | 40 | return _listX(2, malval_new_symbol("quote"), ast); |
31690700 JM |
41 | } else { |
42 | MalVal *a0 = _nth(ast, 0); | |
43 | if ((a0->type & MAL_SYMBOL) && | |
44 | strcmp("unquote", a0->val.string) == 0) { | |
45 | return _nth(ast, 1); | |
46 | } else if (is_pair(a0)) { | |
47 | MalVal *a00 = _nth(a0, 0); | |
48 | if ((a00->type & MAL_SYMBOL) && | |
49 | strcmp("splice-unquote", a00->val.string) == 0) { | |
ea81a808 JM |
50 | return _listX(3, malval_new_symbol("concat"), |
51 | _nth(a0, 1), | |
8cb5cda4 | 52 | quasiquote(_rest(ast))); |
31690700 JM |
53 | } |
54 | } | |
ea81a808 JM |
55 | return _listX(3, malval_new_symbol("cons"), |
56 | quasiquote(a0), | |
8cb5cda4 | 57 | quasiquote(_rest(ast))); |
31690700 JM |
58 | } |
59 | } | |
60 | ||
61 | int is_macro_call(MalVal *ast, Env *env) { | |
62 | if (!ast || ast->type != MAL_LIST) { return 0; } | |
63 | MalVal *a0 = _nth(ast, 0); | |
64 | return (a0->type & MAL_SYMBOL) && | |
b8ee29b2 JM |
65 | env_find(env, a0) && |
66 | env_get(env, a0)->ismacro; | |
31690700 JM |
67 | } |
68 | ||
69 | MalVal *macroexpand(MalVal *ast, Env *env) { | |
70 | if (!ast || mal_error) return NULL; | |
71 | while (is_macro_call(ast, env)) { | |
72 | MalVal *a0 = _nth(ast, 0); | |
b8ee29b2 | 73 | MalVal *mac = env_get(env, a0); |
31690700 | 74 | // TODO: this is weird and limits it to 20. FIXME |
8cb5cda4 | 75 | ast = _apply(mac, _rest(ast)); |
31690700 JM |
76 | } |
77 | return ast; | |
78 | } | |
79 | ||
80 | MalVal *eval_ast(MalVal *ast, Env *env) { | |
81 | if (!ast || mal_error) return NULL; | |
82 | if (ast->type == MAL_SYMBOL) { | |
83 | //g_print("EVAL symbol: %s\n", ast->val.string); | |
b8ee29b2 | 84 | return env_get(env, ast); |
31690700 JM |
85 | } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { |
86 | //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); | |
87 | MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); | |
88 | if (!el || mal_error) return NULL; | |
89 | el->type = ast->type; | |
90 | return el; | |
91 | } else if (ast->type == MAL_HASH_MAP) { | |
92 | //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); | |
93 | GHashTableIter iter; | |
94 | gpointer key, value; | |
95 | MalVal *seq = malval_new_list(MAL_LIST, | |
96 | g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), | |
97 | _count(ast))); | |
98 | g_hash_table_iter_init (&iter, ast->val.hash_table); | |
99 | while (g_hash_table_iter_next (&iter, &key, &value)) { | |
100 | MalVal *kname = malval_new_string((char *)key); | |
101 | g_array_append_val(seq->val.array, kname); | |
102 | MalVal *new_val = EVAL((MalVal *)value, env); | |
103 | g_array_append_val(seq->val.array, new_val); | |
104 | } | |
8cb5cda4 | 105 | return _hash_map(seq); |
31690700 JM |
106 | } else { |
107 | //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); | |
108 | return ast; | |
109 | } | |
110 | } | |
111 | ||
112 | MalVal *EVAL(MalVal *ast, Env *env) { | |
113 | while (TRUE) { | |
31690700 | 114 | |
8cb5cda4 JM |
115 | if (!ast || mal_error) return NULL; |
116 | //g_print("EVAL: %s\n", _pr_str(ast,1)); | |
117 | if (ast->type != MAL_LIST) { | |
118 | return eval_ast(ast, env); | |
119 | } | |
120 | if (!ast || mal_error) return NULL; | |
31690700 | 121 | |
8cb5cda4 JM |
122 | // apply list |
123 | //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); | |
124 | ast = macroexpand(ast, env); | |
125 | if (!ast || mal_error) return NULL; | |
126 | if (ast->type != MAL_LIST) { return ast; } | |
127 | if (_count(ast) == 0) { return ast; } | |
128 | ||
129 | int i, len; | |
130 | MalVal *a0 = _nth(ast, 0); | |
131 | if ((a0->type & MAL_SYMBOL) && | |
132 | strcmp("def!", a0->val.string) == 0) { | |
133 | //g_print("eval apply def!\n"); | |
134 | MalVal *a1 = _nth(ast, 1), | |
135 | *a2 = _nth(ast, 2); | |
136 | MalVal *res = EVAL(a2, env); | |
b8ee29b2 JM |
137 | if (mal_error) return NULL; |
138 | env_set(env, a1, res); | |
8cb5cda4 JM |
139 | return res; |
140 | } else if ((a0->type & MAL_SYMBOL) && | |
141 | strcmp("let*", a0->val.string) == 0) { | |
142 | //g_print("eval apply let*\n"); | |
143 | MalVal *a1 = _nth(ast, 1), | |
144 | *a2 = _nth(ast, 2), | |
145 | *key, *val; | |
146 | assert_type(a1, MAL_LIST|MAL_VECTOR, | |
147 | "let* bindings must be list or vector"); | |
148 | len = _count(a1); | |
149 | assert((len % 2) == 0, "odd number of let* bindings forms"); | |
150 | Env *let_env = new_env(env, NULL, NULL); | |
151 | for(i=0; i<len; i+=2) { | |
152 | key = g_array_index(a1->val.array, MalVal*, i); | |
153 | val = g_array_index(a1->val.array, MalVal*, i+1); | |
154 | assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); | |
b8ee29b2 | 155 | env_set(let_env, key, EVAL(val, let_env)); |
8cb5cda4 | 156 | } |
6301e0b6 JM |
157 | ast = a2; |
158 | env = let_env; | |
159 | // Continue loop | |
8cb5cda4 JM |
160 | } else if ((a0->type & MAL_SYMBOL) && |
161 | strcmp("quote", a0->val.string) == 0) { | |
162 | //g_print("eval apply quote\n"); | |
163 | return _nth(ast, 1); | |
164 | } else if ((a0->type & MAL_SYMBOL) && | |
165 | strcmp("quasiquote", a0->val.string) == 0) { | |
166 | //g_print("eval apply quasiquote\n"); | |
167 | MalVal *a1 = _nth(ast, 1); | |
6301e0b6 JM |
168 | ast = quasiquote(a1); |
169 | // Continue loop | |
8cb5cda4 JM |
170 | } else if ((a0->type & MAL_SYMBOL) && |
171 | strcmp("defmacro!", a0->val.string) == 0) { | |
172 | //g_print("eval apply defmacro!\n"); | |
173 | MalVal *a1 = _nth(ast, 1), | |
174 | *a2 = _nth(ast, 2); | |
175 | MalVal *res = EVAL(a2, env); | |
b8ee29b2 | 176 | if (mal_error) return NULL; |
8cb5cda4 | 177 | res->ismacro = TRUE; |
b8ee29b2 | 178 | env_set(env, a1, res); |
8cb5cda4 JM |
179 | return res; |
180 | } else if ((a0->type & MAL_SYMBOL) && | |
181 | strcmp("macroexpand", a0->val.string) == 0) { | |
182 | //g_print("eval apply macroexpand\n"); | |
183 | MalVal *a1 = _nth(ast, 1); | |
184 | return macroexpand(a1, env); | |
185 | } else if ((a0->type & MAL_SYMBOL) && | |
186 | strcmp(".", a0->val.string) == 0) { | |
187 | //g_print("eval apply .\n"); | |
188 | MalVal *el = eval_ast(_slice(ast, 1, _count(ast)), env); | |
189 | return invoke_native(el); | |
190 | } else if ((a0->type & MAL_SYMBOL) && | |
191 | strcmp("try*", a0->val.string) == 0) { | |
192 | //g_print("eval apply try*\n"); | |
193 | MalVal *a1 = _nth(ast, 1); | |
194 | MalVal *a2 = _nth(ast, 2); | |
195 | MalVal *res = EVAL(a1, env); | |
196 | if (!mal_error) { return res; } | |
197 | MalVal *a20 = _nth(a2, 0); | |
198 | if (strcmp("catch*", a20->val.string) == 0) { | |
199 | MalVal *a21 = _nth(a2, 1); | |
200 | MalVal *a22 = _nth(a2, 2); | |
201 | Env *catch_env = new_env(env, | |
202 | _listX(1, a21), | |
203 | _listX(1, mal_error)); | |
204 | //malval_free(mal_error); | |
205 | mal_error = NULL; | |
206 | res = EVAL(a22, catch_env); | |
31690700 | 207 | return res; |
8cb5cda4 JM |
208 | } else { |
209 | return &mal_nil; | |
210 | } | |
211 | } else if ((a0->type & MAL_SYMBOL) && | |
212 | strcmp("do", a0->val.string) == 0) { | |
213 | //g_print("eval apply do\n"); | |
214 | eval_ast(_slice(ast, 1, _count(ast)-1), env); | |
215 | ast = _last(ast); | |
216 | // Continue loop | |
217 | } else if ((a0->type & MAL_SYMBOL) && | |
218 | strcmp("if", a0->val.string) == 0) { | |
219 | //g_print("eval apply if\n"); | |
220 | MalVal *a1 = _nth(ast, 1); | |
221 | MalVal *cond = EVAL(a1, env); | |
222 | if (!cond || mal_error) return NULL; | |
223 | if (cond->type & (MAL_FALSE|MAL_NIL)) { | |
224 | // eval false slot form | |
b8ee29b2 JM |
225 | if (ast->val.array->len > 3) { |
226 | ast = _nth(ast, 3); | |
227 | } else { | |
31690700 JM |
228 | return &mal_nil; |
229 | } | |
8cb5cda4 JM |
230 | } else { |
231 | // eval true slot form | |
232 | ast = _nth(ast, 2); | |
233 | } | |
234 | // Continue loop | |
235 | } else if ((a0->type & MAL_SYMBOL) && | |
236 | strcmp("fn*", a0->val.string) == 0) { | |
237 | //g_print("eval apply fn*\n"); | |
238 | MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); | |
239 | mf->ismacro = FALSE; | |
240 | mf->val.func.evaluator = EVAL; | |
241 | mf->val.func.args = _nth(ast, 1); | |
242 | mf->val.func.body = _nth(ast, 2); | |
243 | mf->val.func.env = env; | |
244 | return mf; | |
245 | } else { | |
246 | //g_print("eval apply\n"); | |
247 | MalVal *el = eval_ast(ast, env); | |
248 | if (!el || mal_error) { return NULL; } | |
249 | MalVal *f = _first(el), | |
250 | *args = _rest(el); | |
251 | assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, | |
252 | "cannot apply '%s'", _pr_str(f,1)); | |
253 | if (f->type & MAL_FUNCTION_MAL) { | |
254 | ast = f->val.func.body; | |
255 | env = new_env(f->val.func.env, f->val.func.args, args); | |
31690700 | 256 | // Continue loop |
31690700 | 257 | } else { |
8cb5cda4 | 258 | return _apply(f, args); |
31690700 JM |
259 | } |
260 | } | |
8cb5cda4 JM |
261 | |
262 | } // TCO while loop | |
31690700 | 263 | } |
ea81a808 | 264 | |
31690700 JM |
265 | |
266 | char *PRINT(MalVal *exp) { | |
267 | if (mal_error) { | |
268 | fprintf(stderr, "Error: %s\n", mal_error->val.string); | |
269 | malval_free(mal_error); | |
270 | mal_error = NULL; | |
271 | return NULL; | |
272 | } | |
273 | return _pr_str(exp,1); | |
274 | } | |
275 | ||
276 | // repl | |
277 | ||
278 | // read and eval | |
279 | MalVal *RE(Env *env, char *prompt, char *str) { | |
280 | MalVal *ast, *exp; | |
281 | ast = READ(prompt, str); | |
282 | if (!ast || mal_error) return NULL; | |
283 | exp = EVAL(ast, env); | |
284 | if (ast != exp) { | |
285 | malval_free(ast); // Free input structure | |
286 | } | |
287 | return exp; | |
288 | } | |
289 | ||
290 | // Setup the initial REPL environment | |
291 | Env *repl_env; | |
292 | ||
86b689f3 | 293 | void init_repl_env(int argc, char *argv[]) { |
31690700 JM |
294 | repl_env = new_env(NULL, NULL, NULL); |
295 | ||
8cb5cda4 | 296 | // core.c: defined using C |
31690700 | 297 | int i; |
86b689f3 | 298 | for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { |
b8ee29b2 JM |
299 | env_set(repl_env, |
300 | malval_new_symbol(core_ns[i].name), | |
8cb5cda4 | 301 | malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); |
31690700 | 302 | } |
8cb5cda4 | 303 | MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } |
b8ee29b2 JM |
304 | env_set(repl_env, |
305 | malval_new_symbol("eval"), | |
8cb5cda4 | 306 | malval_new_function((void*(*)(void *))do_eval, 1)); |
31690700 | 307 | |
86b689f3 JM |
308 | MalVal *_argv = _listX(0); |
309 | for (i=2; i < argc; i++) { | |
310 | MalVal *arg = malval_new_string(argv[i]); | |
311 | g_array_append_val(_argv->val.array, arg); | |
312 | } | |
b8ee29b2 | 313 | env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); |
86b689f3 | 314 | |
8cb5cda4 | 315 | // core.mal: defined using the language itself |
db4c329a | 316 | RE(repl_env, "", "(def! *host-language* \"c\")"); |
31690700 | 317 | RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); |
31690700 | 318 | RE(repl_env, "", |
1617910a | 319 | "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))"); |
8cb5cda4 JM |
320 | RE(repl_env, "", "(defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw \"odd number of forms to cond\")) (cons 'cond (rest (rest xs)))))))"); |
321 | RE(repl_env, "", "(defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_FIXME ~(first xs)) (if or_FIXME or_FIXME (or ~@(rest xs))))))))"); | |
31690700 JM |
322 | } |
323 | ||
324 | int main(int argc, char *argv[]) | |
325 | { | |
326 | MalVal *exp; | |
327 | char *output; | |
328 | char prompt[100]; | |
329 | ||
330 | // Set the initial prompt and environment | |
331 | snprintf(prompt, sizeof(prompt), "user> "); | |
86b689f3 | 332 | init_repl_env(argc, argv); |
31690700 JM |
333 | |
334 | if (argc > 1) { | |
335 | char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); | |
336 | RE(repl_env, "", cmd); | |
8cb5cda4 JM |
337 | return 0; |
338 | } | |
31690700 | 339 | |
86b689f3 JM |
340 | // repl loop |
341 | RE(repl_env, "", "(println (str \"Mal [\" *host-language* \"]\"))"); | |
8cb5cda4 JM |
342 | for(;;) { |
343 | exp = RE(repl_env, prompt, NULL); | |
344 | if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { | |
345 | return 0; | |
346 | } | |
347 | output = PRINT(exp); | |
31690700 | 348 | |
8cb5cda4 JM |
349 | if (output) { |
350 | g_print("%s\n", output); | |
351 | free(output); // Free output string | |
31690700 | 352 | } |
8cb5cda4 JM |
353 | |
354 | //malval_free(exp); // Free evaluated expression | |
31690700 JM |
355 | } |
356 | } |