12 MalVal
*EVAL(MalVal
*ast
, Env
*env
);
13 MalVal
*macroexpand(MalVal
*ast
, Env
*env
);
16 MalVal
*READ(char prompt
[], char *str
) {
22 line
= _readline(prompt
);
29 if (!str
) { free(line
); }
34 int is_pair(MalVal
*x
) {
35 return _sequential_Q(x
) && (_count(x
) > 0);
38 MalVal
*quasiquote(MalVal
*ast
) {
40 return _listX(2, malval_new_symbol("quote"), ast
);
42 MalVal
*a0
= _nth(ast
, 0);
43 if ((a0
->type
& MAL_SYMBOL
) &&
44 strcmp("unquote", a0
->val
.string
) == 0) {
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) {
50 return _listX(3, malval_new_symbol("concat"),
52 quasiquote(_rest(ast
)));
55 return _listX(3, malval_new_symbol("cons"),
57 quasiquote(_rest(ast
)));
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
) &&
66 env_get(env
, a0
)->ismacro
;
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);
73 MalVal
*mac
= env_get(env
, a0
);
74 // TODO: this is weird and limits it to 20. FIXME
75 ast
= _apply(mac
, _rest(ast
));
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);
84 return env_get(env
, ast
);
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
;
91 } else if (ast
->type
== MAL_HASH_MAP
) {
92 //g_print("EVAL hash_map: %s\n", _pr_str(ast,1));
95 MalVal
*seq
= malval_new_list(MAL_LIST
,
96 g_array_sized_new(TRUE
, TRUE
, sizeof(MalVal
*),
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
);
105 return _hash_map(seq
);
107 //g_print("EVAL scalar: %s\n", _pr_str(ast,1));
112 MalVal
*EVAL(MalVal
*ast
, Env
*env
) {
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
);
120 if (!ast
|| mal_error
) return NULL
;
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
; }
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),
136 MalVal
*res
= EVAL(a2
, env
);
137 if (mal_error
) return NULL
;
138 env_set(env
, a1
, 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),
146 assert_type(a1
, MAL_LIST
|MAL_VECTOR
,
147 "let* bindings must be list or vector");
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");
155 env_set(let_env
, key
, EVAL(val
, let_env
));
160 } else if ((a0
->type
& MAL_SYMBOL
) &&
161 strcmp("quote", a0
->val
.string
) == 0) {
162 //g_print("eval apply quote\n");
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);
168 ast
= quasiquote(a1
);
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),
175 MalVal
*res
= EVAL(a2
, env
);
176 if (mal_error
) return NULL
;
178 env_set(env
, a1
, 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
,
203 _listX(1, mal_error
));
204 //malval_free(mal_error);
206 res
= EVAL(a22
, catch_env
);
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
);
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
225 if (ast
->val
.array
->len
> 3) {
231 // eval true slot form
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
);
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
;
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
),
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
);
258 return _apply(f
, args
);
266 char *PRINT(MalVal
*exp
) {
268 fprintf(stderr
, "Error: %s\n", mal_error
->val
.string
);
269 malval_free(mal_error
);
273 return _pr_str(exp
,1);
279 MalVal
*RE(Env
*env
, char *prompt
, char *str
) {
281 ast
= READ(prompt
, str
);
282 if (!ast
|| mal_error
) return NULL
;
283 exp
= EVAL(ast
, env
);
285 malval_free(ast
); // Free input structure
290 // Setup the initial REPL environment
293 void init_repl_env(int argc
, char *argv
[]) {
294 repl_env
= new_env(NULL
, NULL
, NULL
);
296 // core.c: defined using C
298 for(i
=0; i
< (sizeof(core_ns
) / sizeof(core_ns
[0])); i
++) {
300 malval_new_symbol(core_ns
[i
].name
),
301 malval_new_function(core_ns
[i
].func
, core_ns
[i
].arg_cnt
));
303 MalVal
*do_eval(MalVal
*ast
) { return EVAL(ast
, repl_env
); }
305 malval_new_symbol("eval"),
306 malval_new_function((void*(*)(void *))do_eval
, 1));
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
);
313 env_set(repl_env
, malval_new_symbol("*ARGV*"), _argv
);
315 // core.mal: defined using the language itself
316 RE(repl_env
, "", "(def! *host-language* \"c\")");
317 RE(repl_env
, "", "(def! not (fn* (a) (if a false true)))");
319 "(def! load-file (fn* (f) (eval (read-string (str \"(do \" (slurp f) \")\")))))");
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))))))))");
324 int main(int argc
, char *argv
[])
330 // Set the initial prompt and environment
331 snprintf(prompt
, sizeof(prompt
), "user> ");
332 init_repl_env(argc
, argv
);
335 char *cmd
= g_strdup_printf("(load-file \"%s\")", argv
[1]);
336 RE(repl_env
, "", cmd
);
341 RE(repl_env
, "", "(println (str \"Mal [\" *host-language* \"]\"))");
343 exp
= RE(repl_env
, prompt
, NULL
);
344 if (mal_error
&& strcmp("EOF", mal_error
->val
.string
) == 0) {
350 g_print("%s\n", output
);
351 free(output
); // Free output string
354 //malval_free(exp); // Free evaluated expression