From 6fcdb655a6581963a873224ad01f92b4e88f0de3 Mon Sep 17 00:00:00 2001 From: Bad Diode Date: Sun, 17 Oct 2021 16:08:58 +0200 Subject: Cleanup if call in eval function --- src/bootstrap/gc.c | 2 +- src/bootstrap/main.c | 4 ++- src/bootstrap/primitives.c | 84 ++++++++++++++++++---------------------------- 3 files changed, 37 insertions(+), 53 deletions(-) (limited to 'src/bootstrap') diff --git a/src/bootstrap/gc.c b/src/bootstrap/gc.c index 5f023bc..11a1f5a 100644 --- a/src/bootstrap/gc.c +++ b/src/bootstrap/gc.c @@ -270,7 +270,7 @@ alloc_object(ObjectType type) { // references! Should we work with offsets all the way? That is for // cdr and car? Should we have a utility function? All in all, we // need to refactor the codebase first to work with pointer offsets - // rather than objects. This issue is very important, if we are in + // rather than objects. This issue is very important, if we are in // the middle of an operation that tries to allocate memory but we // had saved pointers to some object, the pointer references may be // invalidated, crashing or worse, silently returning garbage! Let's diff --git a/src/bootstrap/main.c b/src/bootstrap/main.c index bf2354b..2d24f92 100755 --- a/src/bootstrap/main.c +++ b/src/bootstrap/main.c @@ -37,11 +37,13 @@ init(void) { obj_false = alloc_object(OBJ_TYPE_BOOL); obj_err = alloc_object(OBJ_TYPE_ERR); obj_quote = make_symbol((StringView){"quote", 5}); + proc_if = alloc_object(OBJ_TYPE_ERR); push_root(obj_nil); push_root(obj_true); push_root(obj_false); push_root(obj_err); push_root(obj_quote); + push_root(proc_if); // Global environment. global_env = env_create(NULL); @@ -52,6 +54,7 @@ init(void) { // Primitive symbols. MAKE_ENV_VAR(global_env, "else", obj_true); MAKE_ENV_VAR(global_env, "nil", obj_nil); + MAKE_ENV_VAR(global_env, "if", proc_if); // Primitive procedures. MAKE_ENV_PROC(global_env, "eval", proc_eval); @@ -79,7 +82,6 @@ init(void) { MAKE_ENV_PROC(global_env, "not", proc_not); MAKE_ENV_PROC(global_env, "and", proc_and); MAKE_ENV_PROC(global_env, "or", proc_or); - MAKE_ENV_PROC(global_env, "if", proc_if); MAKE_ENV_PROC(global_env, "cond", proc_cond); MAKE_ENV_PROC(global_env, "<", proc_num_less_than); MAKE_ENV_PROC(global_env, "<=", proc_num_lesseq_than); diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c index 0403e3a..ab147d4 100644 --- a/src/bootstrap/primitives.c +++ b/src/bootstrap/primitives.c @@ -1,6 +1,5 @@ #define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n"); - -Object * proc_if(Environment *env, Object *obj); +static Object *proc_if; Object * eval(Environment *env, Object *root) { @@ -41,32 +40,34 @@ eval_start: }); return obj_err; } - if (val->type == OBJ_TYPE_PROCEDURE) { - // TODO: This is very messy, needs refactoring. - if (val->proc == proc_if) { - Object *obj = root->cdr; - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *car = obj->car; - Object *cdr = obj->cdr; - Object *condition = eval(env, car); - if (condition == obj_err) { - return obj_err; - } - if (condition == obj_true) { - root = cdr->car; - } else if (cdr->cdr != obj_nil) { - root = cdr->cdr->car; - } else { - return obj_nil; - } - goto eval_start; + + // Primitive `if` procedure with TCO. + if (val == proc_if) { + Object *obj = root->cdr; + if (obj == obj_nil || obj->cdr == obj_nil) { + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_NOT_ENOUGH_ARGS, + }); + return obj_err; } + Object *car = obj->car; + Object *cdr = obj->cdr; + Object *condition = eval(env, car); + if (condition == obj_err) { + return obj_err; + } + if (condition == obj_true) { + root = cdr->car; + } else if (cdr->cdr != obj_nil) { + root = cdr->cdr->car; + } else { + return obj_nil; + } + goto eval_start; + } + + if (val->type == OBJ_TYPE_PROCEDURE) { ret = val->proc(env, root->cdr); goto eval_success; } @@ -138,6 +139,11 @@ eval_lambda: root = root->car; goto eval_start; } + error_push((Error){ + .type = ERR_TYPE_RUNTIME, + .value = ERR_OBJ_NOT_CALLABLE, + }); + return obj_err; } break; } @@ -482,30 +488,6 @@ proc_or(Environment *env, Object *obj) { return obj_false; } -Object * -proc_if(Environment *env, Object *obj) { - if (obj == obj_nil || obj->cdr == obj_nil) { - error_push((Error){ - .type = ERR_TYPE_RUNTIME, - .value = ERR_NOT_ENOUGH_ARGS, - }); - return obj_err; - } - Object *car = obj->car; - Object *cdr = obj->cdr; - Object *condition = eval(env, car); - if (condition == obj_err) { - return obj_err; - } - if (condition == obj_true) { - return eval(env, cdr->car); - } - if (cdr->cdr != obj_nil) { - return eval(env, cdr->cdr->car); - } - return obj_nil; -} - Object * proc_cond(Environment *env, Object *obj) { if (obj == obj_nil) { -- cgit v1.2.1