diff options
Diffstat (limited to 'src/main.c')
| -rw-r--r-- | src/main.c | 125 |
1 files changed, 56 insertions, 69 deletions
@@ -9,7 +9,6 @@ #include "env.h" #ifdef ENABLE_MEMDEBUG -#define MEMDEBUG_OUT_OF_BOUNDS #define MEMDEBUG_IMPLEMENTATION #define MEMDEBUG_OUTPUT_DIR "files" #endif @@ -164,18 +163,6 @@ static struct toklist *cons_to_toklist(value_t value); static env_t global_env = ENV_EMPTY; static value_t global_nil = VALUE_EMPTY; -static void destroy_env(char *key, value_t value) -{ - (void)key; - value_destroy(value); -} - -static void destroy_global_env(char *key, value_t value) -{ - free(key); - value_destroy(value); -} - int main(int argc, char **argv) { int opt, repl_flag = 0; @@ -205,27 +192,25 @@ int main(int argc, char **argv) if(!filename) repl_flag = 1; + FILE *fp = stdin; + if(!repl_flag) { + fp = fopen(filename, "r"); + if(!fp) { + die("fopen: %s", strerror(errno)); + } + } - env_t builtin_env = env_create(ENV_EMPTY, destroy_env); - global_env = env_create(builtin_env, destroy_global_env); + global_env = env_create(NULL); global_nil = value_create(VALUE_NIL, NULL); for(size_t i = 0; i < BUILTIN_PROCEDURES; i++) { value_t proc_value = value_create( VALUE_PROC_BUILTIN, (void *)&builtin_proc_descriptions[i]); - - env_insert(builtin_env, - builtin_proc_name_list[i], - proc_value, NULL, NULL); - } - FILE *fp = stdin; - if(!repl_flag) { - fp = fopen(filename, "r"); - if(!fp) { - die("fopen: %s", strerror(errno)); - } + ERR_NZ(env_insert(global_env, builtin_proc_name_list[i], + proc_value, NULL, 0), r, + return r); } lexer_t lexer = lexer_create(fp); @@ -236,7 +221,7 @@ int main(int argc, char **argv) if(repl_flag) printf("> "); while(next_token(&tctx)) { - value_t val = evaluate_expr(ENV_EMPTY, &tctx); + value_t val = evaluate_expr(global_env, &tctx); if(val == VALUE_EMPTY) { if(!repl_flag) { @@ -261,11 +246,11 @@ int main(int argc, char **argv) value_destroy(val); } - lexer_destroy(lexer); - fclose(fp); - value_destroy(global_nil); env_destroy(global_env); + + lexer_destroy(lexer); + fclose(fp); return 0; } @@ -277,12 +262,17 @@ static char *str_alloc_copy(char *src) return memcpy(malloc(len), src, len); } -#define HAS_ENOUGH_ARGS(proc, type, argc, fail) \ - if(argc != vvalue_##type(proc).argc) { \ - err("Wrong number of arguemnts, expected %zu, but got %zu", \ - vvalue_##type(proc).argc, argc); \ - fail; \ - } +// static char *str_temp_copy(char *src) +// { +// if(!src) return src; + +// static char[256] dest; +// size_t len = strlen(src) + 1; + +// return (sizeof(dest) < len) +// ? NULL +// : memcpy(dest, src, len); +// } static value_t apply_lambda(struct proc *proc, value_t *args) { @@ -290,18 +280,17 @@ static value_t apply_lambda(struct proc *proc, value_t *args) env_t env = ENV_EMPTY; struct tctx tctx = {0}; - ERR_Z(env = env_create(env_copy(proc->parent_env), destroy_env), goto exit); + ERR_Z(env = env_create(proc->parent_env), goto exit); tctx_init_toklist(&tctx, proc->body); for(size_t i = 0; i < proc->argc; i++) { - ERR_NZ(env_insert(env, proc->arg_keys[i]->value.atom, - value_copy(args[i]), NULL, NULL), + ERR_NZ(env_insert(env, vvalue_atom(proc->arg_keys[i]), + value_copy(args[i]), NULL, 0), _r, goto exit); } TOKEN_NEXT(&tctx); ret = evaluate_expr(env, &tctx); - exit: env_destroy(env); return ret; @@ -330,6 +319,13 @@ exit: return ret; } +#define HAS_ENOUGH_ARGS(proc, type, argc, fail) \ + if(argc != vvalue_##type(proc).argc) { \ + err("Wrong number of arguemnts, expected %zu, but got %zu", \ + vvalue_##type(proc).argc, argc); \ + fail; \ + } + value_t apply(env_t env, value_t proc, size_t argc, value_t *argv) { if(proc == VALUE_EMPTY) return value_copy(global_nil); @@ -454,21 +450,13 @@ exit: value_t evaluate_id(env_t env, struct tctx *tctx) { - if(env == ENV_EMPTY) { - return evaluate_id(global_env, tctx); - } - value_t ret = VALUE_EMPTY; ERR_NZ(env_query(env, TOKEN(tctx)->value.id, &ret), _r, goto fail); return value_copy(ret); - fail: - if(env == env_parent(global_env)) { - err("Symbol %s is unbound", TOKEN(tctx)->value.id); - return VALUE_EMPTY; - } - return evaluate_id(env_parent(env), tctx); + err("Symbol %s is unbound", TOKEN(tctx)->value.id); + return VALUE_EMPTY; } value_t evaluate_lambda(env_t env, struct tctx *tctx) @@ -528,12 +516,6 @@ value_t evaluate_define(env_t env, struct tctx *tctx) // TODO: don't alloc when the key is the same char *key = NULL; - // only in the outside environement - if(env != ENV_EMPTY) { - err("define can only be called in the outermost environement"); - goto fail; - } - TOKEN_SKIP(tctx, TOKEN_DEFINE, goto fail); switch(TOKEN(tctx)->type) @@ -556,18 +538,22 @@ value_t evaluate_define(env_t env, struct tctx *tctx) goto fail); value_t prevval = VALUE_EMPTY; - char *prevkey = NULL; + int flags = ENV_KV_FREE_KEY; + flags |= (vvalue_type(val) == VALUE_PROC) ? ENV_KV_CIRCULAR_REF : 0; ERR_NZ( - env_insert(global_env, key, val, &prevkey, &prevval), + env_insert(env, key, val, &prevval, flags), r, { err("Couldn't insert symbol into the environement due to %s", strerror(r)); value_destroy(val); // the copy goto fail; }); - if(prevkey) free(prevkey); - value_destroy(prevval); + if(prevval) { + free(key); + value_destroy(prevval); + } + return value_copy(global_nil); fail: @@ -632,30 +618,31 @@ value_t evaluate_defmacro(env_t env, struct tctx *tctx) } // unsafe and bad - tctx->token->type = TOKEN_LAMBDA; + TOKEN(tctx)->type = TOKEN_LAMBDA; ERR_Z(lambda = evaluate_lambda(env, tctx), goto fail); value_set_type(lambda, VALUE_MACRO); - // TOKEN_MATCH(tctx, TOKEN_RP, goto fail); - value_t prevval = VALUE_EMPTY; - char *prevkey = NULL; + int flags = ENV_KV_FREE_KEY | ENV_KV_CIRCULAR_REF; ERR_NZ( - env_insert(global_env, key, lambda, &prevkey, &prevval), + env_insert(env, key, lambda, &prevval, flags), r, { err("Couldn't insert symbol into the environement due to %s", strerror(r)); + value_destroy(lambda); goto fail; }); - if(prevkey) free(prevkey); - value_destroy(prevval); + if(prevval) { + free(key); + value_destroy(prevval); + } + return value_copy(global_nil); fail: - value_destroy(lambda); - if(key)free(key); + if(key) free(key); return VALUE_EMPTY; } |