#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
+
#include "types.h"
#include "readline.h"
#include "reader.h"
MalVal *new_val = EVAL((MalVal *)value, env);
g_array_append_val(seq->val.array, new_val);
}
- return hash_map(seq);
+ return _hash_map(seq);
} else {
//g_print("EVAL scalar: %s\n", _pr_str(ast,1));
return ast;
MalVal *EVAL(MalVal *ast, Env *env) {
while (TRUE) {
- //g_print("EVAL: %s\n", _pr_str(ast,1));
- if (!ast || mal_error) return NULL;
- if (ast->type != MAL_LIST) {
- return eval_ast(ast, env);
+
+ if (!ast || mal_error) return NULL;
+ //g_print("EVAL: %s\n", _pr_str(ast,1));
+ if (ast->type != MAL_LIST) {
+ return eval_ast(ast, env);
+ }
+ if (!ast || mal_error) return NULL;
+
+ // apply list
+ //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
+ int i, len;
+ if (_count(ast) == 0) { return ast; }
+ MalVal *a0 = _nth(ast, 0);
+ if ((a0->type & MAL_SYMBOL) &&
+ strcmp("def!", a0->val.string) == 0) {
+ //g_print("eval apply def!\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2);
+ MalVal *res = EVAL(a2, env);
+ env_set(env, a1->val.string, res);
+ return res;
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("let*", a0->val.string) == 0) {
+ //g_print("eval apply let*\n");
+ MalVal *a1 = _nth(ast, 1),
+ *a2 = _nth(ast, 2),
+ *key, *val;
+ assert_type(a1, MAL_LIST|MAL_VECTOR,
+ "let* bindings must be list or vector");
+ len = _count(a1);
+ assert((len % 2) == 0, "odd number of let* bindings forms");
+ Env *let_env = new_env(env, NULL, NULL);
+ for(i=0; i<len; i+=2) {
+ key = g_array_index(a1->val.array, MalVal*, i);
+ val = g_array_index(a1->val.array, MalVal*, i+1);
+ assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
+ env_set(let_env, key->val.string, EVAL(val, let_env));
}
- if (!ast || mal_error) return NULL;
-
- // apply list
- //g_print("EVAL apply list: %s\n", _pr_str(ast,1));
- int i, len;
- if (_count(ast) == 0) { return ast; }
- MalVal *a0 = _nth(ast, 0);
- if ((a0->type & MAL_SYMBOL) &&
- strcmp("def!", a0->val.string) == 0) {
- //g_print("eval apply def!\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2);
- MalVal *res = EVAL(a2, env);
- env_set(env, a1->val.string, res);
- return res;
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("let*", a0->val.string) == 0) {
- //g_print("eval apply let*\n");
- MalVal *a1 = _nth(ast, 1),
- *a2 = _nth(ast, 2),
- *key, *val;
- assert_type(a1, MAL_LIST|MAL_VECTOR,
- "let* bindings must be list or vector");
- len = _count(a1);
- assert((len % 2) == 0, "odd number of let* bindings forms");
- Env *let_env = new_env(env, NULL, NULL);
- for(i=0; i<len; i+=2) {
- key = g_array_index(a1->val.array, MalVal*, i);
- val = g_array_index(a1->val.array, MalVal*, i+1);
- assert_type(key, MAL_SYMBOL, "let* bind to non-symbol");
- env_set(let_env, key->val.string, EVAL(val, let_env));
- }
- return EVAL(a2, let_env);
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("do", a0->val.string) == 0) {
- //g_print("eval apply do\n");
- eval_ast(_slice(ast, 1, _count(ast)-1), env);
- ast = last(ast);
- // Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("if", a0->val.string) == 0) {
- //g_print("eval apply if\n");
- MalVal *a1 = _nth(ast, 1);
- MalVal *cond = EVAL(a1, env);
- if (!cond || mal_error) return NULL;
- if (cond->type & (MAL_FALSE|MAL_NIL)) {
- // eval false slot form
- ast = _nth(ast, 3);
- if (!ast) {
- return &mal_nil;
- }
- } else {
- // eval true slot form
- ast = _nth(ast, 2);
+ return EVAL(a2, let_env);
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("do", a0->val.string) == 0) {
+ //g_print("eval apply do\n");
+ eval_ast(_slice(ast, 1, _count(ast)-1), env);
+ ast = _last(ast);
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("if", a0->val.string) == 0) {
+ //g_print("eval apply if\n");
+ MalVal *a1 = _nth(ast, 1);
+ MalVal *cond = EVAL(a1, env);
+ if (!cond || mal_error) return NULL;
+ if (cond->type & (MAL_FALSE|MAL_NIL)) {
+ // eval false slot form
+ ast = _nth(ast, 3);
+ if (!ast) {
+ return &mal_nil;
}
+ } else {
+ // eval true slot form
+ ast = _nth(ast, 2);
+ }
+ // Continue loop
+ } else if ((a0->type & MAL_SYMBOL) &&
+ strcmp("fn*", a0->val.string) == 0) {
+ //g_print("eval apply fn*\n");
+ MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
+ mf->val.func.evaluator = EVAL;
+ mf->val.func.args = _nth(ast, 1);
+ mf->val.func.body = _nth(ast, 2);
+ mf->val.func.env = env;
+ return mf;
+ } else {
+ //g_print("eval apply\n");
+ MalVal *el = eval_ast(ast, env);
+ if (!el || mal_error) { return NULL; }
+ MalVal *f = _first(el),
+ *args = _rest(el);
+ assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
+ "cannot apply '%s'", _pr_str(f,1));
+ if (f->type & MAL_FUNCTION_MAL) {
+ ast = f->val.func.body;
+ env = new_env(f->val.func.env, f->val.func.args, args);
// Continue loop
- } else if ((a0->type & MAL_SYMBOL) &&
- strcmp("fn*", a0->val.string) == 0) {
- //g_print("eval apply fn*\n");
- MalVal *mf = malval_new(MAL_FUNCTION_MAL, NULL);
- mf->val.func.evaluator = EVAL;
- mf->val.func.args = _nth(ast, 1);
- mf->val.func.body = _nth(ast, 2);
- mf->val.func.env = env;
- return mf;
} else {
- //g_print("eval apply\n");
- MalVal *el = eval_ast(ast, env);
- if (!el || mal_error) { return NULL; }
- MalVal *f = first(el),
- *args = rest(el);
- assert_type(f, MAL_FUNCTION_C|MAL_FUNCTION_MAL,
- "cannot invoke '%s'", _pr_str(f,1));
- if (f->type & MAL_FUNCTION_MAL) {
- ast = f->val.func.body;
- env = new_env(f->val.func.env, f->val.func.args, args);
- // Continue loop
- } else {
- return _apply(f, args);
- }
+ return _apply(f, args);
}
}
+
+ } // TCO while loop
}
// print
Env *repl_env;
void init_repl_env() {
- void _ref(char *name, MalVal*(*func)(MalVal*), int arg_cnt) {
- void *(*f)(void *) = (void*(*)(void*))func;
- env_set(repl_env, name, malval_new_function(f, arg_cnt, NULL));
- }
repl_env = new_env(NULL, NULL, NULL);
+ // core.c: defined using C
int i;
for(i=0; i< (sizeof(core_ns) / sizeof(core_ns[0])); i++) {
- MalVal *(*f)(MalVal *) = (MalVal*(*)(MalVal*))core_ns[i].func;
- _ref(core_ns[i].name, f, core_ns[i].arg_cnt);
+ env_set(repl_env, core_ns[i].name,
+ malval_new_function(core_ns[i].func, core_ns[i].arg_cnt));
}
+ // core.mal: defined using the language itself
RE(repl_env, "", "(def! not (fn* (a) (if a false true)))");
}
HCoop / jackhill / mal.git / blobdiff