From 54060b06acd084f75bfda00517479902a5652391 Mon Sep 17 00:00:00 2001
From: Bad Diode <bd@badd10de.dev>
Date: Sat, 16 Oct 2021 21:56:00 +0200
Subject: Add explicit TCO for lambda and if procedure

---
 src/bootstrap/gc.c         |  4 ++--
 src/bootstrap/primitives.c | 53 +++++++++++++++++++++++++++++++++++++---------
 2 files changed, 45 insertions(+), 12 deletions(-)

(limited to 'src/bootstrap')

diff --git a/src/bootstrap/gc.c b/src/bootstrap/gc.c
index 6e15c63..b63ee2b 100644
--- a/src/bootstrap/gc.c
+++ b/src/bootstrap/gc.c
@@ -35,7 +35,7 @@ alloc_env(void) {
     if (gc.envs.size < gc.envs.cap) {
         return &gc.envs.buf[gc.envs.size++];
     }
-    printf("error: not enough room for more environments\n");
+    fprintf(stderr, "error: not enough room for more environments\n");
     return NULL;
 }
 
@@ -188,7 +188,7 @@ alloc_object(ObjectType type) {
     if (gc.available_slots == 0) {
         mark_and_sweep();
         if (gc.available_slots == 0) {
-            printf("NOT MORE MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n");
+            fprintf(stderr, "NOT MORE MEMORY AVAILABLE WHERE IS YOUR GOD NOW MWAHAHA\n");
             dump_gc();
             exit(EXIT_FAILURE);
             // TODO: grow heap tables.
diff --git a/src/bootstrap/primitives.c b/src/bootstrap/primitives.c
index abb87e7..a814e40 100644
--- a/src/bootstrap/primitives.c
+++ b/src/bootstrap/primitives.c
@@ -1,7 +1,12 @@
 #define DEBUG_OBJ(MSG,OBJ) printf((MSG)); display(OBJ); printf("\n");
 
+Object * proc_if(Environment *env, Object *obj);
+
 Object *
-eval(Environment* env, Object *root) {
+eval(Environment *env, Object *root) {
+    Object* lambda;
+    bool recursion_active = false;
+eval_start:
     switch (root->type) {
         case OBJ_TYPE_ERR:
         case OBJ_TYPE_PROCEDURE:
@@ -34,9 +39,35 @@ eval(Environment* env, Object *root) {
                     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;
+                    }
                     return val->proc(env, root->cdr);
                 }
                 if (val->type == OBJ_TYPE_LAMBDA) {
+                    lambda = val;
                     goto eval_lambda;
                 }
                 error_push((Error){
@@ -45,17 +76,19 @@ eval(Environment* env, Object *root) {
                 });
                 return obj_err;
             }
-            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->params;
-                env = env_extend(fun->env, env);
+                Object *args;
+eval_lambda:
+                args = root->cdr;
+                Object *params = lambda->params;
+                if (!recursion_active) {
+                    env = env_extend(lambda->env, env);
+                    recursion_active = true;
+                }
                 while (params != obj_nil) {
                     if (args == obj_nil) {
                         error_push((Error){
@@ -87,15 +120,15 @@ eval_lambda:
                     });
                     return obj_err;
                 }
-                root = fun->body;
+                root = lambda->body;
                 while (root->cdr != obj_nil) {
                     if (eval(env, root->car) == obj_err) {
                         return obj_err;
                     };
                     root = root->cdr;
                 }
-                root = eval(env, root->car);
-                return root;
+                root = root->car;
+                goto eval_start;
             }
         } break;
     }
-- 
cgit v1.2.1