tail-rec for `if` and `and`

6 files changed, 116 insertions, 90 deletions

diff --git a/builtin.cpp b/builtin.cpp
index f4440cb..47fdda8 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -14,8 +14,6 @@ using std::stringstream;
 extern EmptyList *empty_list;
 extern UnspecObj *unspec_obj;
 
-
-
 SpecialOptIf::SpecialOptIf() : SpecialOptObj("if") {}
 
 void SpecialOptIf::prepare(Pair *pc) {
@@ -49,8 +47,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
-            EXIT_CURRENT_EXEC(lenvt, cont);
-            gc.expose(args);
+            EXIT_CURRENT_EXEC(lenvt, cont, args);
             return ret_addr->next;          // Move to the next instruction
         }
         else 
@@ -61,21 +58,39 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
 
             if (TO_PAIR(args->cdr)->car->is_true())
             {
-                second->next = NULL;
-                // Undo pop and invoke again
-                gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
-                top_ptr++;
-                cont->state = empty_list;
+                if (second->car->is_simple_obj())
+                {
+                    second->next = NULL;
+                    // Undo pop and invoke again
+                    gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+                    top_ptr++;
+                    cont->state = empty_list;
+                }
+                else                        // tail recursion opt
+                {
+                    cont->tail = true;
+                    cont->state = NULL;
+                    top_ptr++;
+                }
                 gc.expose(args);
                 return second;
             }
             else if (third != empty_list)
             {
-                third->next = NULL;
-                // Undo pop and invoke again
-                gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
-                top_ptr++;
-                cont->state = empty_list;
+                if (third->car->is_simple_obj())
+                {
+                    third->next = NULL;
+                    // Undo pop and invoke again
+                    gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+                    top_ptr++;
+                    cont->state = empty_list;
+                }
+                else                        // tail recursion opt
+                {
+                    cont->tail = true;
+                    cont->state = NULL;
+                    top_ptr++;
+                }
                 gc.expose(args);
                 return third;
             }
@@ -83,8 +98,7 @@ Pair *SpecialOptIf::call(Pair *args, Environment * &lenvt,
             {
                 gc.expose(*top_ptr);
                 *top_ptr++ = gc.attach(unspec_obj);
-                EXIT_CURRENT_EXEC(lenvt, cont);
-                gc.expose(args);
+                EXIT_CURRENT_EXEC(lenvt, cont, args);
                 return ret_addr->next;
             }
         }
@@ -174,8 +188,7 @@ Pair *SpecialOptLambda::call(Pair *args, Environment * &lenvt,
 
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(new ProcObj(body, lenvt, params));
-    EXIT_CURRENT_EXEC(lenvt, cont);
-    gc.expose(args);
+    EXIT_CURRENT_EXEC(lenvt, cont, args);
     return ret_addr->next;  // Move to the next instruction
 }
 
@@ -250,8 +263,7 @@ Pair *SpecialOptDefine::call(Pair *args, Environment * &lenvt,
     lenvt->add_binding(id, obj);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(unspec_obj);
-    EXIT_CURRENT_EXEC(lenvt, cont);
-    gc.expose(args);
+    EXIT_CURRENT_EXEC(lenvt, cont, args);
     return ret_addr->next;
 }
 
@@ -297,8 +309,7 @@ Pair *SpecialOptSet::call(Pair *args, Environment * &lenvt,
     if (!flag) throw TokenError(id->ext_repr(), RUN_ERR_UNBOUND_VAR);
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(unspec_obj);
-    EXIT_CURRENT_EXEC(lenvt, cont);
-    gc.expose(args);
+    EXIT_CURRENT_EXEC(lenvt, cont, args);
     return ret_addr->next;
 }
 
@@ -314,8 +325,7 @@ Pair *SpecialOptQuote::call(Pair *args, Environment * &lenvt,
     Pair *ret_addr = cont->pc;
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(TO_PAIR(pc->cdr)->car);
-    EXIT_CURRENT_EXEC(lenvt, cont);
-    gc.expose(args);
+    EXIT_CURRENT_EXEC(lenvt, cont, args);
     return ret_addr->next;
 }
 
@@ -335,8 +345,7 @@ Pair *SpecialOptEval::call(Pair *args, Environment * &lenvt,
         gc.expose(cont->state);     // Exec done
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(TO_PAIR(args->cdr)->car);
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;          // Move to the next instruction
     }
     else
@@ -361,50 +370,70 @@ void SpecialOptAnd::prepare(Pair *pc) {
 Pair *SpecialOptAnd::call(Pair *args, Environment * &lenvt,
         Continuation * &cont, EvalObj ** &top_ptr, Pair *pc) {
     Pair *ret_addr = cont->pc;
-    if (pc->cdr == empty_list)
+    Pair *cs = cont->state;
+    Pair *nexp;
+    if (pc->cdr == empty_list)              // empty list
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(new BoolObj(true));
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;
     }
-    if (!cont->state)
+    if (!cs)                       // spawn the first
     {
-        gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
-        top_ptr++;
-        cont->state = TO_PAIR(pc->cdr);
-        cont->state->next = NULL;
-        gc.expose(args);
-        return cont->state;
+        nexp = cont->state = TO_PAIR(pc->cdr);
+        if (nexp->cdr == empty_list && !nexp->car->is_simple_obj())
+        {
+            cont->tail = true;
+            cont->state = NULL;
+            top_ptr++;
+            gc.expose(args);
+            return nexp;
+        } 
+        else
+        {
+            gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
+            top_ptr++;
+            nexp->next = NULL;
+            gc.expose(args);
+            return nexp;
+        }
     }
+
     EvalObj *ret = TO_PAIR(args->cdr)->car;
     if (ret->is_true())
     {
-        if (cont->state->cdr == empty_list) // the last member
+        if (cs->cdr == empty_list) // the last member
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(ret);
-            EXIT_CURRENT_EXEC(lenvt, cont);
-            gc.expose(args);
+            EXIT_CURRENT_EXEC(lenvt, cont, args);
             return ret_addr->next;
         }
         else
         {
+            nexp = TO_PAIR(cs->cdr);
+            if (nexp->cdr == empty_list && !nexp->car->is_simple_obj())
+            {
+                cont->tail = true;
+                cont->state = NULL;
+                top_ptr++;
+                gc.expose(args);
+                return nexp;
+            }  
             gc.attach(static_cast<EvalObj*>(*(++top_ptr)));
             top_ptr++;
-            cont->state = TO_PAIR(cont->state->cdr);
-            cont->state->next = NULL;
+            nexp = cont->state = TO_PAIR(cont->state->cdr);
+            nexp->next = NULL;
             gc.expose(args);
-            return cont->state;
+            return nexp;
         }
     }
     else
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(ret);
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;
     }
     throw NormalError(INT_ERR);
@@ -423,8 +452,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(new BoolObj(false));
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;
     }
     if (!cont->state)
@@ -443,8 +471,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(ret);
-            EXIT_CURRENT_EXEC(lenvt, cont);
-            gc.expose(args);
+            EXIT_CURRENT_EXEC(lenvt, cont, args);
             return ret_addr->next;
         }
         else
@@ -461,8 +488,7 @@ Pair *SpecialOptOr::call(Pair *args, Environment * &lenvt,
     {
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(ret);
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;
     }
     throw NormalError(INT_ERR);
@@ -532,8 +558,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
         prom->feed_mem(mem);
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(mem);
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(_args);
+        EXIT_CURRENT_EXEC(lenvt, cont, _args);
         return ret_addr->next;          // Move to the next instruction
     }
     else
@@ -546,8 +571,7 @@ Pair *SpecialOptForce::call(Pair *_args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(mem);
-            EXIT_CURRENT_EXEC(lenvt, cont);
-            gc.expose(_args);
+            EXIT_CURRENT_EXEC(lenvt, cont, _args);
             return ret_addr->next;      
         }
         else                            // force
@@ -576,8 +600,7 @@ Pair *SpecialOptDelay::call(Pair *args, Environment * &lenvt,
     Pair *ret_addr = cont->pc;
     gc.expose(*top_ptr);
     *top_ptr++ = gc.attach(new PromObj(TO_PAIR(pc->cdr)->car));
-    EXIT_CURRENT_EXEC(lenvt, cont);
-    gc.expose(args);
+    EXIT_CURRENT_EXEC(lenvt, cont, args);
     return ret_addr->next;          // Move to the next instruction
 }
 
diff --git a/eval.cpp b/eval.cpp
index 45427e4..c6ded6e 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -186,7 +186,7 @@ EvalObj *Evaluator::run_expr(Pair *prog) {
             }
             else
                 throw TokenError((args->car)->ext_repr(), SYN_ERR_CAN_NOT_APPLY);
-            gc.collect();
+//            gc.collect();
         }
     }
     gc.expose(prog);
diff --git a/gc.cpp b/gc.cpp
index 4df2d46..28a7360 100644
--- a/gc.cpp
+++ b/gc.cpp
@@ -3,8 +3,8 @@
 #include "consts.h"
 #include <vector>
 
-#if defined(GC_DEBUG) || defined (GC_INFO)
 #include <cstdio>
+#if defined(GC_DEBUG) || defined (GC_INFO)
 typedef unsigned long long ull;
 #endif
 
@@ -24,16 +24,18 @@ GarbageCollector::PendingEntry::PendingEntry(
 void GarbageCollector::expose(EvalObj *ptr) {
     if (ptr == NULL) return;
 #ifdef GC_DEBUG
-        fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", 
+    fprintf(stderr, "GC: 0x%llx exposed. count = %lu \"%s\"\n", 
             (ull)ptr, ptr->gc_get_cnt() - 1, ptr->ext_repr().c_str());
 #endif
-        if (ptr->gc_dec())
-        {
+    /*        if (ptr->gc_get_cnt() == 0)
+              puts("oops");*/
+    if (ptr->gc_dec())
+    {
 #ifdef GC_DEBUG
-            fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr);
+        fprintf(stderr, "GC: 0x%llx pending. \n", (ull)ptr);
 #endif
-            pending_list = new PendingEntry(ptr, pending_list);
-        } 
+        pending_list = new PendingEntry(ptr, pending_list);
+    } 
 }
 
 void GarbageCollector::force() {
diff --git a/gc.h b/gc.h
index 2a0aac6..2d1c179 100644
--- a/gc.h
+++ b/gc.h
@@ -8,6 +8,7 @@ const int GC_QUEUE_SIZE = 262144;
 const size_t GC_CYC_THRESHOLD = GC_QUEUE_SIZE >> 1;
 
 typedef std::set<EvalObj*> EvalObjSet;
+class GarbageCollector;
 
 #define GC_CYC_TRIGGER(ptr) \
 do { \
@@ -21,6 +22,27 @@ do { \
         static_cast<Container*>(ptr)->gc_refs--; \
 } while (0)
     
+extern GarbageCollector gc;
+#define EXIT_CURRENT_ENVT(lenvt) \
+    do { \
+        gc.expose(lenvt); \
+        lenvt = cont->envt; \
+        gc.attach(lenvt); \
+    } while (0)
+#define EXIT_CURRENT_CONT(cont) \
+    do { \
+        gc.expose(cont); \
+        cont = cont->prev_cont; \
+        gc.attach(cont); \
+    } while (0)
+
+#define EXIT_CURRENT_EXEC(lenvt, cont, args) \
+    do { \
+        EXIT_CURRENT_ENVT(lenvt); \
+        EXIT_CURRENT_CONT(cont); \
+        gc.expose(args); \
+        gc.collect(); \
+    } while (0)
 
 class GarbageCollector {
 
@@ -47,6 +69,5 @@ class GarbageCollector {
     EvalObj *attach(EvalObj *ptr);
 };
 
-extern GarbageCollector gc;
 
 #endif
diff --git a/model.h b/model.h
index 964d68b..ba40137 100644
--- a/model.h
+++ b/model.h
@@ -21,24 +21,6 @@ const int CLS_CONTAINER = 1 << 20;
 #define TO_PAIR(ptr) \
     (static_cast<Pair*>(ptr))
 
-#define EXIT_CURRENT_ENVT(lenvt) \
-    do { \
-        gc.expose(lenvt); \
-        lenvt = cont->envt; \
-        gc.attach(lenvt); \
-    } while (0)
-#define EXIT_CURRENT_CONT(cont) \
-    do { \
-        gc.expose(cont); \
-        cont = cont->prev_cont; \
-        gc.attach(cont); \
-    } while (0)
-
-#define EXIT_CURRENT_EXEC(lenvt, cont) \
-    do { \
-        EXIT_CURRENT_ENVT(lenvt); \
-        EXIT_CURRENT_CONT(cont); \
-    } while (0)
 
 /** @class FrameObj
  * Objects that can be held in the evaluation stack
diff --git a/types.cpp b/types.cpp
index b00459a..b583061 100644
--- a/types.cpp
+++ b/types.cpp
@@ -88,17 +88,16 @@ Pair *ProcObj::call(Pair *_args, Environment * &lenvt,
         {
             gc.expose(*top_ptr);
             *top_ptr++ = gc.attach(TO_PAIR(_args->cdr)->car);
-            EXIT_CURRENT_EXEC(lenvt, cont); // exit cont and envt
-            gc.expose(_args);
+            EXIT_CURRENT_EXEC(lenvt, cont, _args); // exit cont and envt
             return ret_addr->next;
         }
         else 
         {
             if (nexp->cdr == empty_list && !nexp->car->is_simple_obj())    // tail recursion opt
             {
-                    cont->tail = true;
-                    cont->state = NULL;
-                    top_ptr++;              // revert the cont
+                cont->tail = true;
+                cont->state = NULL;
+                top_ptr++;              // revert the cont
             }
             else
             {
@@ -311,8 +310,7 @@ BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
         Pair *ret_addr = cont->pc;
         gc.expose(*top_ptr);
         *top_ptr++ = gc.attach(handler(TO_PAIR(args->cdr), name));
-        EXIT_CURRENT_EXEC(lenvt, cont);
-        gc.expose(args);
+        EXIT_CURRENT_EXEC(lenvt, cont, args);
         return ret_addr->next;          // Move to the next instruction
     }