Commit | Line | Data |
---|---|---|
31690700 JM |
1 | #include <stdlib.h> |
2 | #include <stdio.h> | |
b81b2a7e | 3 | #include <string.h> |
31690700 | 4 | #include <unistd.h> |
8cb5cda4 | 5 | |
31690700 JM |
6 | #include "types.h" |
7 | #include "readline.h" | |
8 | #include "reader.h" | |
ea81a808 | 9 | #include "core.h" |
31690700 JM |
10 | |
11 | // Declarations | |
12 | MalVal *EVAL(MalVal *ast, Env *env); | |
13 | ||
14 | // read | |
15 | MalVal *READ(char prompt[], char *str) { | |
16 | char *line; | |
17 | MalVal *ast; | |
18 | if (str) { | |
19 | line = str; | |
20 | } else { | |
21 | line = _readline(prompt); | |
22 | if (!line) { | |
23 | _error("EOF"); | |
24 | return NULL; | |
25 | } | |
26 | } | |
27 | ast = read_str(line); | |
6b3ecaa7 | 28 | if (!str) { MAL_GC_FREE(line); } |
31690700 JM |
29 | return ast; |
30 | } | |
31 | ||
32 | // eval | |
33 | MalVal *eval_ast(MalVal *ast, Env *env) { | |
34 | if (!ast || mal_error) return NULL; | |
35 | if (ast->type == MAL_SYMBOL) { | |
36 | //g_print("EVAL symbol: %s\n", ast->val.string); | |
b8ee29b2 | 37 | return env_get(env, ast); |
31690700 JM |
38 | } else if ((ast->type == MAL_LIST) || (ast->type == MAL_VECTOR)) { |
39 | //g_print("EVAL sequential: %s\n", _pr_str(ast,1)); | |
40 | MalVal *el = _map2((MalVal *(*)(void*, void*))EVAL, ast, env); | |
41 | if (!el || mal_error) return NULL; | |
42 | el->type = ast->type; | |
43 | return el; | |
44 | } else if (ast->type == MAL_HASH_MAP) { | |
45 | //g_print("EVAL hash_map: %s\n", _pr_str(ast,1)); | |
46 | GHashTableIter iter; | |
47 | gpointer key, value; | |
48 | MalVal *seq = malval_new_list(MAL_LIST, | |
49 | g_array_sized_new(TRUE, TRUE, sizeof(MalVal*), | |
50 | _count(ast))); | |
51 | g_hash_table_iter_init (&iter, ast->val.hash_table); | |
52 | while (g_hash_table_iter_next (&iter, &key, &value)) { | |
53 | MalVal *kname = malval_new_string((char *)key); | |
54 | g_array_append_val(seq->val.array, kname); | |
55 | MalVal *new_val = EVAL((MalVal *)value, env); | |
56 | g_array_append_val(seq->val.array, new_val); | |
57 | } | |
8cb5cda4 | 58 | return _hash_map(seq); |
31690700 JM |
59 | } else { |
60 | //g_print("EVAL scalar: %s\n", _pr_str(ast,1)); | |
61 | return ast; | |
62 | } | |
63 | } | |
64 | ||
65 | MalVal *EVAL(MalVal *ast, Env *env) { | |
66 | while (TRUE) { | |
31690700 | 67 | |
8cb5cda4 JM |
68 | if (!ast || mal_error) return NULL; |
69 | //g_print("EVAL: %s\n", _pr_str(ast,1)); | |
70 | if (ast->type != MAL_LIST) { | |
71 | return eval_ast(ast, env); | |
72 | } | |
73 | if (!ast || mal_error) return NULL; | |
74 | ||
75 | // apply list | |
76 | //g_print("EVAL apply list: %s\n", _pr_str(ast,1)); | |
77 | int i, len; | |
78 | if (_count(ast) == 0) { return ast; } | |
79 | MalVal *a0 = _nth(ast, 0); | |
80 | if ((a0->type & MAL_SYMBOL) && | |
81 | strcmp("def!", a0->val.string) == 0) { | |
82 | //g_print("eval apply def!\n"); | |
83 | MalVal *a1 = _nth(ast, 1), | |
84 | *a2 = _nth(ast, 2); | |
85 | MalVal *res = EVAL(a2, env); | |
b8ee29b2 JM |
86 | if (mal_error) return NULL; |
87 | env_set(env, a1, res); | |
8cb5cda4 JM |
88 | return res; |
89 | } else if ((a0->type & MAL_SYMBOL) && | |
90 | strcmp("let*", a0->val.string) == 0) { | |
91 | //g_print("eval apply let*\n"); | |
92 | MalVal *a1 = _nth(ast, 1), | |
93 | *a2 = _nth(ast, 2), | |
94 | *key, *val; | |
95 | assert_type(a1, MAL_LIST|MAL_VECTOR, | |
96 | "let* bindings must be list or vector"); | |
97 | len = _count(a1); | |
98 | assert((len % 2) == 0, "odd number of let* bindings forms"); | |
99 | Env *let_env = new_env(env, NULL, NULL); | |
100 | for(i=0; i<len; i+=2) { | |
101 | key = g_array_index(a1->val.array, MalVal*, i); | |
102 | val = g_array_index(a1->val.array, MalVal*, i+1); | |
103 | assert_type(key, MAL_SYMBOL, "let* bind to non-symbol"); | |
b8ee29b2 | 104 | env_set(let_env, key, EVAL(val, let_env)); |
8cb5cda4 | 105 | } |
6301e0b6 JM |
106 | ast = a2; |
107 | env = let_env; | |
108 | // Continue loop | |
8cb5cda4 JM |
109 | } else if ((a0->type & MAL_SYMBOL) && |
110 | strcmp("do", a0->val.string) == 0) { | |
111 | //g_print("eval apply do\n"); | |
112 | eval_ast(_slice(ast, 1, _count(ast)-1), env); | |
113 | ast = _last(ast); | |
114 | // Continue loop | |
115 | } else if ((a0->type & MAL_SYMBOL) && | |
116 | strcmp("if", a0->val.string) == 0) { | |
117 | //g_print("eval apply if\n"); | |
118 | MalVal *a1 = _nth(ast, 1); | |
119 | MalVal *cond = EVAL(a1, env); | |
120 | if (!cond || mal_error) return NULL; | |
121 | if (cond->type & (MAL_FALSE|MAL_NIL)) { | |
122 | // eval false slot form | |
b8ee29b2 JM |
123 | if (ast->val.array->len > 3) { |
124 | ast = _nth(ast, 3); | |
125 | } else { | |
8cb5cda4 | 126 | return &mal_nil; |
31690700 | 127 | } |
8cb5cda4 JM |
128 | } else { |
129 | // eval true slot form | |
130 | ast = _nth(ast, 2); | |
131 | } | |
132 | // Continue loop | |
133 | } else if ((a0->type & MAL_SYMBOL) && | |
134 | strcmp("fn*", a0->val.string) == 0) { | |
135 | //g_print("eval apply fn*\n"); | |
136 | MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL); | |
137 | mf->val.func.evaluator = EVAL; | |
138 | mf->val.func.args = _nth(ast, 1); | |
139 | mf->val.func.body = _nth(ast, 2); | |
140 | mf->val.func.env = env; | |
141 | return mf; | |
142 | } else { | |
143 | //g_print("eval apply\n"); | |
144 | MalVal *el = eval_ast(ast, env); | |
145 | if (!el || mal_error) { return NULL; } | |
146 | MalVal *f = _first(el), | |
147 | *args = _rest(el); | |
148 | assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL, | |
149 | "cannot apply '%s'", _pr_str(f,1)); | |
150 | if (f->type & MAL_FUNCTION_MAL) { | |
151 | ast = f->val.func.body; | |
152 | env = new_env(f->val.func.env, f->val.func.args, args); | |
31690700 | 153 | // Continue loop |
31690700 | 154 | } else { |
8cb5cda4 | 155 | return _apply(f, args); |
31690700 JM |
156 | } |
157 | } | |
8cb5cda4 JM |
158 | |
159 | } // TCO while loop | |
31690700 JM |
160 | } |
161 | ||
162 | ||
163 | char *PRINT(MalVal *exp) { | |
164 | if (mal_error) { | |
31690700 JM |
165 | return NULL; |
166 | } | |
167 | return _pr_str(exp,1); | |
168 | } | |
169 | ||
170 | // repl | |
171 | ||
172 | // read and eval | |
173 | MalVal *RE(Env *env, char *prompt, char *str) { | |
174 | MalVal *ast, *exp; | |
175 | ast = READ(prompt, str); | |
176 | if (!ast || mal_error) return NULL; | |
177 | exp = EVAL(ast, env); | |
178 | if (ast != exp) { | |
179 | malval_free(ast); // Free input structure | |
180 | } | |
181 | return exp; | |
182 | } | |
183 | ||
184 | // Setup the initial REPL environment | |
185 | Env *repl_env; | |
186 | ||
b81b2a7e LB |
187 | MalVal *do_eval(MalVal *ast) { return EVAL(ast, repl_env); } |
188 | ||
86b689f3 | 189 | void init_repl_env(int argc, char *argv[]) { |
31690700 JM |
190 | repl_env = new_env(NULL, NULL, NULL); |
191 | ||
8cb5cda4 | 192 | // core.c: defined using C |
31690700 | 193 | int i; |
86b689f3 | 194 | for(i=0; i < (sizeof(core_ns) / sizeof(core_ns[0])); i++) { |
b8ee29b2 JM |
195 | env_set(repl_env, |
196 | malval_new_symbol(core_ns[i].name), | |
8cb5cda4 | 197 | malval_new_function(core_ns[i].func, core_ns[i].arg_cnt)); |
31690700 | 198 | } |
b8ee29b2 JM |
199 | env_set(repl_env, |
200 | malval_new_symbol("eval"), | |
8cb5cda4 | 201 | malval_new_function((void*(*)(void *))do_eval, 1)); |
31690700 | 202 | |
86b689f3 JM |
203 | MalVal *_argv = _listX(0); |
204 | for (i=2; i < argc; i++) { | |
205 | MalVal *arg = malval_new_string(argv[i]); | |
206 | g_array_append_val(_argv->val.array, arg); | |
207 | } | |
b8ee29b2 | 208 | env_set(repl_env, malval_new_symbol("*ARGV*"), _argv); |
86b689f3 | 209 | |
8cb5cda4 | 210 | // core.mal: defined using the language itself |
31690700 JM |
211 | RE(repl_env, "", "(def! not (fn* (a) (if a false true)))"); |
212 | RE(repl_env, "", | |
e6d41de4 | 213 | "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \"\nnil)\")))))"); |
31690700 JM |
214 | } |
215 | ||
216 | int main(int argc, char *argv[]) | |
217 | { | |
218 | MalVal *exp; | |
219 | char *output; | |
220 | char prompt[100]; | |
221 | ||
6b3ecaa7 DM |
222 | MAL_GC_SETUP(); |
223 | ||
31690700 JM |
224 | // Set the initial prompt and environment |
225 | snprintf(prompt, sizeof(prompt), "user> "); | |
86b689f3 | 226 | init_repl_env(argc, argv); |
dd7a4f55 | 227 | |
31690700 JM |
228 | if (argc > 1) { |
229 | char *cmd = g_strdup_printf("(load-file \"%s\")", argv[1]); | |
230 | RE(repl_env, "", cmd); | |
8cb5cda4 JM |
231 | return 0; |
232 | } | |
31690700 | 233 | |
86b689f3 | 234 | // repl loop |
8cb5cda4 JM |
235 | for(;;) { |
236 | exp = RE(repl_env, prompt, NULL); | |
237 | if (mal_error && strcmp("EOF", mal_error->val.string) == 0) { | |
238 | return 0; | |
239 | } | |
240 | output = PRINT(exp); | |
31690700 | 241 | |
dd7a4f55 JM |
242 | if (mal_error) { |
243 | fprintf(stderr, "Error: %s\n", _pr_str(mal_error,1)); | |
244 | malval_free(mal_error); | |
245 | mal_error = NULL; | |
246 | } else if (output) { | |
6b3ecaa7 DM |
247 | puts(output); |
248 | MAL_GC_FREE(output); // Free output string | |
31690700 | 249 | } |
8cb5cda4 JM |
250 | |
251 | //malval_free(exp); // Free evaluated expression | |
31690700 JM |
252 | } |
253 | } |