support for equal?

10 files changed, 117 insertions, 13 deletions

diff --git a/Makefile b/Makefile
index 07feba0..790d71e 100644
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,7 @@ main: main.o parser.o builtin.o model.o eval.o exc.o consts.o
 	g++ -o main $^ -pg -lgmp
 
 .cpp.o:
-	g++ $< -c -g -pg -DGMP_SUPPORT
+	g++ $< -c -O2 -g -pg -DGMP_SUPPORT
 
 clean:
 	rm -f *.o
diff --git a/TODO.rst b/TODO.rst
index 6ac8d4e..1a5df0e 100644
--- a/TODO.rst
+++ b/TODO.rst
@@ -1,4 +1,4 @@
-- non-recursive ext_repr implementation
 - non-recursive equal? predicate
+- ext_repr optimization 
 - Garbage Collection?
 - Add macro support
diff --git a/builtin.cpp b/builtin.cpp
index adf069d..72efb37 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1256,6 +1256,107 @@ BUILTIN_PROC_DEF(is_eqv) {
     return new BoolObj(obj1 == obj2);
 }
 
+
+BUILTIN_PROC_DEF(is_equal) {
+
+#define INC1(x) (++(x) == t1 ? (x) = q1:0)
+#define INC2(x) (++(x) == t2 ? (x) = q2:0)
+    
+    static EvalObj *q1[EQUAL_QUEUE_SIZE], *q2[EQUAL_QUEUE_SIZE];
+    static EvalObj ** const t1 = q1 + EQUAL_QUEUE_SIZE;
+    static EvalObj ** const t2 = q2 + EQUAL_QUEUE_SIZE;
+
+    ARGS_EXACTLY_TWO;
+    EvalObj **l1 = q1, **r1 = l1;
+    EvalObj **l2 = q2, **r2 = l2;
+
+    *r1++ = args->car;
+    *r2++ = TO_PAIR(args->cdr)->car;
+
+    EvalObj *a, *b;
+    for (; l1 != r1; INC1(l1), INC2(l2))
+    {
+        // Different types
+        int otype = (a = *l1)->get_otype();
+        if (otype != (b = *l2)->get_otype())
+            return new BoolObj(false);
+        if (a == empty_list)
+            continue;
+        if (otype & CLS_CONS_OBJ)
+        {
+            *r1 = TO_PAIR(a)->car;
+            INC1(r1);
+            *r1 = TO_PAIR(a)->cdr;
+            INC1(r1);
+
+            *r2 = TO_PAIR(b)->car;
+            INC2(r2);
+            *r2 = TO_PAIR(b)->cdr;
+            INC2(r2);
+        }
+        else if (otype & CLS_VECT_OBJ)
+        {
+            VecObj *va = static_cast<VecObj*>(a);
+            VecObj *vb = static_cast<VecObj*>(b);
+            if (va->get_size() != vb->get_size())
+                return new BoolObj(false);
+            for (EvalObjVec::iterator 
+                    it = va->vec.begin(); 
+                    it != va->vec.end(); it++)
+            {
+                *r1 = TO_PAIR(a)->car;
+                INC1(r1);
+            }
+
+            for (EvalObjVec::iterator 
+                    it = vb->vec.begin(); 
+                    it != vb->vec.end(); it++)
+            {
+                *r2 = TO_PAIR(b)->car;
+                INC2(r2);
+            }
+        }
+        else if (otype & CLS_BOOL_OBJ)
+        {
+            if (static_cast<BoolObj*>(a)->val != 
+                static_cast<BoolObj*>(b)->val)
+                return new BoolObj(false);
+        }
+        else if (otype & CLS_SYM_OBJ)
+        {
+            if (static_cast<SymObj*>(a)->val !=
+                static_cast<SymObj*>(b)->val)
+                return new BoolObj(false);
+        }
+        else if (otype & CLS_NUM_OBJ)
+        {
+            NumObj *num1 = static_cast<NumObj*>(a);
+            NumObj *num2 = static_cast<NumObj*>(b);
+            if (num1->is_exact() != num2->is_exact())
+            return new BoolObj(false);
+            if (num1->level < num2->level)
+                if (!num1->eq(num1->convert(num2)))
+                    return new BoolObj(false);
+            else
+                if (!num2->eq(num2->convert(num1)))
+                    return new BoolObj(false);
+        }
+        else if (otype & CLS_CHAR_OBJ)
+        {
+            if (static_cast<CharObj*>(a)->ch !=
+                static_cast<CharObj*>(b)->ch)
+                return new BoolObj(false); // (char=?)
+        }
+        else if (otype & CLS_STR_OBJ)
+        {
+            if (static_cast<StrObj*>(a)->str !=
+                static_cast<StrObj*>(b)->str)
+                return new BoolObj(false); // (string=?)
+        }
+    }
+    return new BoolObj(true);
+}
+
 BUILTIN_PROC_DEF(display) {
     ARGS_EXACTLY_ONE;
     printf("%s\n", args->car->ext_repr().c_str());
diff --git a/builtin.h b/builtin.h
index 2633ed8..3f6fa29 100644
--- a/builtin.h
+++ b/builtin.h
@@ -7,6 +7,7 @@
 
 using std::string;
 
+const int EQUAL_QUEUE_SIZE = 262144;
 bool is_list(Pair *ptr);
 
 /** @class InexactNumObj
@@ -266,6 +267,7 @@ BUILTIN_PROC_DEF(reverse);
 BUILTIN_PROC_DEF(list_tail);
 
 BUILTIN_PROC_DEF(is_eqv);
+BUILTIN_PROC_DEF(is_equal);
 
 BUILTIN_PROC_DEF(display);
 
diff --git a/eval.cpp b/eval.cpp
index 98d3d5a..2d03c0c 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -5,7 +5,6 @@
 #include <cstdio>
 
 extern Pair *empty_list;
-const int EVAL_STACK_SIZE = 65536;
 FrameObj *eval_stack[EVAL_STACK_SIZE];
 
 void Evaluator::add_builtin_routines() {
@@ -54,6 +53,7 @@ void Evaluator::add_builtin_routines() {
 
     ADD_BUILTIN_PROC("eqv?", is_eqv);
     ADD_BUILTIN_PROC("eq?", is_eqv);
+    ADD_BUILTIN_PROC("equal?", is_equal);
 
     ADD_BUILTIN_PROC("display", display);
 }
@@ -67,8 +67,6 @@ void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) {
     if (pc->car->is_simple_obj())           // Not an opt invocation
     {
         *top_ptr = envt->get_obj(pc->car);  // Objectify the symbol
-        // static_cast because of is_simple_obj() is true
-        static_cast<EvalObj*>(*top_ptr)->prepare(pc);
         top_ptr++;
         pc = pc->next;                      // Move to the next instruction
     }
@@ -82,6 +80,7 @@ void push(Pair * &pc, FrameObj ** &top_ptr, Environment *envt) {
             throw TokenError(pc->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); 
         // static_cast because of is_simple_obj() is false
         pc = static_cast<Pair*>(pc->car);  // Go deeper to enter the call
+        envt->get_obj(pc->car)->prepare(pc);
     }
 }
 
diff --git a/eval.h b/eval.h
index 1c8d14f..bf4b801 100644
--- a/eval.h
+++ b/eval.h
@@ -2,6 +2,7 @@
 #define EVAL_H
 #include "model.h"
 
+const int EVAL_STACK_SIZE = 262144;
 /** @class Evaluator 
  * A runtime platform of interpreting
  */
diff --git a/main.cpp b/main.cpp
index db635e8..ba47a6a 100644
--- a/main.cpp
+++ b/main.cpp
@@ -6,7 +6,7 @@
 #include <cstdio>
 
 int main() {
-    freopen("in.scm", "r", stdin);
+//    freopen("in.scm", "r", stdin);
     Tokenizor *tk = new Tokenizor();
     ASTGenerator *ast = new ASTGenerator();
     Evaluator *eval = new Evaluator();
diff --git a/model.cpp b/model.cpp
index 4502577..3573339 100644
--- a/model.cpp
+++ b/model.cpp
@@ -50,7 +50,7 @@ bool EvalObj::is_bool_obj() {
     return otype & CLS_BOOL_OBJ;
 }
 
-ClassType EvalObj::get_otype() {
+int EvalObj::get_otype() {
     return otype;
 }
 
diff --git a/model.h b/model.h
index 062a61d..be4da2b 100644
--- a/model.h
+++ b/model.h
@@ -23,15 +23,17 @@ const int CLS_REPR_STR = 1 << 4;
 
 const int CLS_SIM_OBJ = 1 << 0;
 const int CLS_CONS_OBJ = 1 << 1;
-const int CLS_SYM_OBJ = 1 << 2;
+
 const int CLS_OPT_OBJ = 1 << 3;
+
+const int CLS_SYM_OBJ = 1 << 2;
 const int CLS_NUM_OBJ = 1 << 4;
 const int CLS_BOOL_OBJ = 1 << 5;
 const int CLS_CHAR_OBJ = 1 << 6;
 const int CLS_STR_OBJ = 1 << 7;
 const int CLS_VECT_OBJ = 1 << 8;
 
-const int REPR_STACK_SIZE = 65536;
+const int REPR_STACK_SIZE = 262144;
 
 #define TO_PAIR(ptr) \
     (static_cast<Pair*>(ptr))
@@ -102,7 +104,7 @@ class EvalObj : public FrameObj {
         bool is_num_obj();
         /** Check if the object is a boolean */
         bool is_bool_obj();
-        ClassType get_otype();
+        int get_otype();
         virtual void prepare(Pair *pc);
         /** Any EvalObj has its external representation */
         string ext_repr();
@@ -366,9 +368,8 @@ typedef vector<EvalObj*> EvalObjVec;
  * Vector support (currently a wrapper of STL vector)
  */
 class VecObj: public EvalObj {
-    private:
-        EvalObjVec vec;
     public:
+        EvalObjVec vec;
         /** Construct a vector object */
         VecObj();
         int get_size();
diff --git a/parser.h b/parser.h
index e44abbc..823c90e 100644
--- a/parser.h
+++ b/parser.h
@@ -7,7 +7,7 @@
 using std::string;
 
 const int TOKEN_BUFF_SIZE = 65536;
-const int PARSE_STACK_SIZE = 65536;
+const int PARSE_STACK_SIZE = 262144;
 
 /** @class Tokenizor 
  * Break down the input string stream into tokens