From 530ed15ec941194e661010498cf30b7842710939 Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Thu, 14 Oct 2021 17:05:37 +0200 Subject: Fix lambda and closures --- src/bootstrap/environment.c | 52 +++++++++++++++++++++++++++++++++++++++++- src/bootstrap/primitives.c | 55 ++++++++++++++++++++------------------------- 2 files changed, 75 insertions(+), 32 deletions(-) (limited to 'src/bootstrap') diff --git a/src/bootstrap/environment.c b/src/bootstrap/environment.c index 99dd7fd..e111753 100644 --- a/src/bootstrap/environment.c +++ b/src/bootstrap/environment.c @@ -60,8 +60,27 @@ env_lookup(Environment *env, Object *symbol) { return obj_err; } +Object * +env_update(Environment *env, Object *symbol, Object *value) { + while (env != NULL) { + for (size_t i = 0; i < env->size; i++) { + EnvEntry entry = env->buf[i]; + if (obj_eq(symbol, entry.symbol)) { + env->buf[i].value = obj_duplicate(value); + return obj_nil; + } + } + env = env->parent; + } + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_SYMBOL_NOT_FOUND, + }); + return obj_err; +} + ssize_t -env_symbol_index_in_current_env(Environment *env, Object *symbol) { +env_index_current(Environment *env, Object *symbol) { for (size_t i = 0; i < env->size; i++) { EnvEntry entry = env->buf[i]; if (obj_eq(symbol, entry.symbol)) { @@ -70,3 +89,34 @@ env_symbol_index_in_current_env(Environment *env, Object *symbol) { } return -1; } + +void +env_add_or_update_current(Environment *env, Object *symbol, Object *value) { + ssize_t index = env_index_current(env, symbol); + if (index == -1) { + env_add_symbol(env, obj_duplicate(symbol), obj_duplicate(value)); + } else { + env->buf[index].value = obj_duplicate(value); + } +} + +Environment * +env_extend(Environment *parent, Environment *extra) { + Environment *env = env_create(parent); + for (size_t i = 0; i < extra->size; i++) { + EnvEntry entry = extra->buf[i]; + Environment *tmp = env; + ssize_t idx = -1; + while (tmp != NULL) { + idx = env_index_current(tmp, entry.symbol); + if (idx != -1) { + break; + } + tmp = tmp->parent; + } + if (idx == -1) { + env_add_symbol(env, obj_duplicate(entry.symbol), obj_duplicate(entry.value)); + } + } + return env; +} diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 461799e..4ef56d5 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c @@ -1,6 +1,7 @@ +#define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); + Object * eval(Environment* env, Object *root) { -tailcall: switch (root->type) { case OBJ_TYPE_ERR: case OBJ_TYPE_PROCEDURE: @@ -35,17 +36,26 @@ tailcall: if (val->type == OBJ_TYPE_PROCEDURE) { return val->proc(env, root->cdr); } + if (val->type == OBJ_TYPE_LAMBDA) { + goto eval_lambda; + } error_push((Error){ .type = ERR_TYPE_RUNTIME, .value = ERR_OBJ_NOT_CALLABLE, }); return obj_err; } - Object* lambda = eval(env, root->car); + Object* lambda; +eval_lambda: + lambda = eval(env, root->car); + if (lambda == obj_err) { + return obj_err; + } if (lambda->type == OBJ_TYPE_LAMBDA) { Object *fun = lambda; Object *args = root->cdr; Object *params = fun->args; + env = env_extend(fun->env, env); while (params != obj_nil) { if (args == obj_nil) { error_push((Error){ @@ -66,12 +76,7 @@ tailcall: }); return obj_err; } - ssize_t index = env_symbol_index_in_current_env(fun->env, symbol); - if (index == -1) { - env_add_symbol(fun->env, obj_duplicate(symbol), obj_duplicate(value)); - } else { - fun->env->buf[index].value = obj_duplicate(value); - } + env_add_or_update_current(env, symbol, value); args = args->cdr; params = params->cdr; } @@ -82,10 +87,14 @@ tailcall: }); return obj_err; } - - env = fun->env; root = fun->body; - goto tailcall; + while (root->cdr != obj_nil) { + if (eval(env, root->car) == obj_err) { + return obj_err; + }; + root = root->cdr; + } + return eval(env, root->car); } } break; } @@ -693,13 +702,7 @@ proc_define(Environment *env, Object *obj) { return obj_err; } - // Make a copy of the symbol and to make them permanent in the environment. - ssize_t index = env_symbol_index_in_current_env(env, symbol); - if (index == -1) { - env_add_symbol(env, obj_duplicate(symbol), obj_duplicate(value)); - } else { - env->buf[index].value = obj_duplicate(value); - } + env_add_or_update_current(env, symbol, value); return obj_nil; } @@ -727,17 +730,7 @@ proc_set(Environment *env, Object *obj) { return obj_err; } - ssize_t index = env_symbol_index_in_current_env(env, symbol); - if (index == -1) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_SYMBOL_NOT_FOUND, - }); - return obj_err; - } - - env->buf[index].value = obj_duplicate(value); - return obj_nil; + return env_update(env, symbol, value); } Object * @@ -757,11 +750,11 @@ proc_lambda(Environment *env, Object *obj) { }); return obj_err; } - Object *body = obj->cdr->car; + Object *body = obj->cdr; Object *fun = alloc_object(OBJ_TYPE_LAMBDA); fun->args = obj_duplicate(args); fun->body = obj_duplicate(body); - fun->env = env_create(env); + fun->env = env; return fun; } -- cgit v1.2.1