fixed some severe problems and added tests

3 files changed, 214 insertions, 78 deletions

diff --git a/builtin.cpp b/builtin.cpp
index e5eb988..394f417 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -22,7 +22,7 @@ static const int NUM_LVL_INT = 3;
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS) \
 
 #define ARGS_EXACTLY_ONE \
-    if (args == empty_list || !args->cdr->is_cons_obj() ) \
+    if (args == empty_list || args->cdr != empty_list ) \
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
 
 #define ARGS_AT_LEAST_ONE \
@@ -30,6 +30,7 @@ static const int NUM_LVL_INT = 3;
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
 
 bool is_list(Cons *ptr) {
+    if (ptr == empty_list) return true;
     EvalObj *nptr; 
     for (;;) 
         if ((nptr = ptr->cdr)->is_cons_obj()) 
@@ -530,7 +531,7 @@ do  \
     for (ptr = TO_CONS(p);;)  \
     { \
         if (!ptr->car->is_sym_obj()) \
-            throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_NUM_OF_ARGS); \
+            throw TokenError(ptr->car->ext_repr(), RUN_ERR_WRONG_TYPE); \
         if ((nptr = ptr->cdr)->is_cons_obj()) \
             ptr = TO_CONS(nptr); \
         else break; \
@@ -707,7 +708,7 @@ BUILTIN_PROC_DEF(make_pair) {
 BUILTIN_PROC_DEF(pair_car) {
     ARGS_EXACTLY_ONE;
     if (!args->car->is_cons_obj())
-        throw TokenError(name, RUN_ERR_WRONG_TYPE);
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
 
     return TO_CONS(args->car)->car;
 }
@@ -715,7 +716,7 @@ BUILTIN_PROC_DEF(pair_car) {
 BUILTIN_PROC_DEF(pair_cdr) {
     ARGS_EXACTLY_ONE;
     if (!args->car->is_cons_obj())
-        throw TokenError(name, RUN_ERR_WRONG_TYPE);
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
 
     return TO_CONS(args->car)->cdr;
 }
@@ -730,12 +731,11 @@ BUILTIN_PROC_DEF(num_add) {
     ARGS_AT_LEAST_ONE;
     NumObj *res = new IntNumObj(0), *opr; // the most accurate type
     EvalObj *nptr;
-    Cons *ptr;
-    for (ptr = args;;)
+    for (;;)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         NumObj *_res = res;
         if (_res->level < opr->level)
             opr = _res->convert(opr);
@@ -743,11 +743,11 @@ BUILTIN_PROC_DEF(num_add) {
             _res =  opr->convert(_res);
         res = _res->plus(opr);
         
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
         else break;
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return res; 
 }
@@ -758,13 +758,16 @@ BUILTIN_PROC_DEF(num_sub) {
         throw TokenError("a number", RUN_ERR_WRONG_TYPE);
 
     NumObj *res = static_cast<NumObj*>(args->car), *opr;
-    EvalObj *nptr;
-    Cons *ptr;
-    for (ptr = TO_CONS(args->cdr);;)
+    EvalObj *nptr; 
+    for (;;)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;        
+
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         // upper type conversion
         NumObj *_res = res;
         if (_res->level < opr->level)
@@ -772,12 +775,8 @@ BUILTIN_PROC_DEF(num_sub) {
         else
             _res =  opr->convert(_res);
         res = _res->minus(opr);
-        
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
-        else break;        
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return res; 
 }
@@ -786,12 +785,11 @@ BUILTIN_PROC_DEF(num_multi) {
     ARGS_AT_LEAST_ONE;
     NumObj *res = new IntNumObj(1), *opr; // the most accurate type
     EvalObj *nptr;
-    Cons *ptr;
-    for (ptr = args;;)
+    for (;;)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         NumObj *_res = res;
         if (_res->level < opr->level)
             opr = _res->convert(opr);
@@ -799,11 +797,11 @@ BUILTIN_PROC_DEF(num_multi) {
             _res =  opr->convert(_res);
         res = _res->multi(opr);
         
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
         else break;
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return res; 
 }
@@ -814,13 +812,16 @@ BUILTIN_PROC_DEF(num_div) {
         throw TokenError("a number", RUN_ERR_WRONG_TYPE);
 
     NumObj *res = static_cast<NumObj*>(args->car), *opr;
-    EvalObj *nptr;
-    Cons *ptr;
-    for (ptr = TO_CONS(args->cdr);;)
+    EvalObj *nptr; 
+    for (;;)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;        
+
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         // upper type conversion
         NumObj *_res = res;
         if (_res->level < opr->level)
@@ -828,30 +829,30 @@ BUILTIN_PROC_DEF(num_div) {
         else
             _res =  opr->convert(_res);
         res = _res->div(opr);
-        
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
-        else break;        
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return res; 
 }
 
 BUILTIN_PROC_DEF(num_lt) {
-    ARGS_AT_LEAST_ONE;
+    if (args == empty_list)
+        return new BoolObj(true);
+    // zero arguments
     if (!args->car->is_num_obj())
         throw TokenError("a number", RUN_ERR_WRONG_TYPE);
 
     NumObj *last = static_cast<NumObj*>(args->car), *opr; 
     EvalObj *nptr;
-    Cons *ptr;
     
-    for (ptr = TO_CONS(args->cdr);; last = opr)
+    for (;; last = opr)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;              
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         // upper type conversion
         if (last->level < opr->level)
             opr = last->convert(opr);
@@ -859,30 +860,30 @@ BUILTIN_PROC_DEF(num_lt) {
             last = opr->convert(last);
         if (!last->lt(opr))
             return new BoolObj(false);
-            
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
-        else break;              
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return new BoolObj(true);
 }
 
 BUILTIN_PROC_DEF(num_gt) {
-    ARGS_AT_LEAST_ONE;
+    if (args == empty_list)
+        return new BoolObj(true);
+    // zero arguments
     if (!args->car->is_num_obj())
         throw TokenError("a number", RUN_ERR_WRONG_TYPE);
 
     NumObj *last = static_cast<NumObj*>(args->car), *opr; 
     EvalObj *nptr;
-    Cons *ptr;
     
-    for (ptr = TO_CONS(args->cdr);; last = opr)
+    for (;; last = opr)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;              
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         // upper type conversion
         if (last->level < opr->level)
             opr = last->convert(opr);
@@ -890,30 +891,30 @@ BUILTIN_PROC_DEF(num_gt) {
             last = opr->convert(last);
         if (!last->gt(opr))
             return new BoolObj(false);
-            
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
-        else break;              
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return new BoolObj(true);
 }
 
 BUILTIN_PROC_DEF(num_eq) {
-    ARGS_AT_LEAST_ONE;
+    if (args == empty_list)
+        return new BoolObj(true);
+    // zero arguments
     if (!args->car->is_num_obj())
         throw TokenError("a number", RUN_ERR_WRONG_TYPE);
 
     NumObj *last = static_cast<NumObj*>(args->car), *opr; 
     EvalObj *nptr;
-    Cons *ptr;
     
-    for (ptr = TO_CONS(args->cdr);; last = opr)
+    for (;; last = opr)
     {
-        if (!ptr->car->is_num_obj())        // not a number
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;              
+        if (!args->car->is_num_obj())        // not a number
             throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-        opr = static_cast<NumObj*>(ptr->car);
+        opr = static_cast<NumObj*>(args->car);
         // upper type conversion
         if (last->level < opr->level)
             opr = last->convert(opr);
@@ -921,12 +922,8 @@ BUILTIN_PROC_DEF(num_eq) {
             last = opr->convert(last);
         if (!last->eq(opr))
             return new BoolObj(false);
-            
-        if ((nptr = ptr->cdr)->is_cons_obj())
-            ptr = TO_CONS(nptr);
-        else break;              
     }
-    if (ptr->cdr != empty_list)
+    if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     return new BoolObj(true);
 }
@@ -949,7 +946,7 @@ BUILTIN_PROC_DEF(is_pair) {
 BUILTIN_PROC_DEF(pair_set_car) {
     ARGS_EXACTLY_TWO;
     if (!args->car->is_cons_obj())
-        throw TokenError(name, RUN_ERR_WRONG_TYPE);
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
     TO_CONS(args->car)->car = TO_CONS(args->cdr)->car;
     return new UnspecObj();
 }
@@ -957,7 +954,7 @@ BUILTIN_PROC_DEF(pair_set_car) {
 BUILTIN_PROC_DEF(pair_set_cdr) {
     ARGS_EXACTLY_TWO;
     if (!args->car->is_cons_obj())
-        throw TokenError(name, RUN_ERR_WRONG_TYPE);
+        throw TokenError("pair", RUN_ERR_WRONG_TYPE);
     TO_CONS(args->car)->cdr = TO_CONS(args->cdr)->car;
     return new UnspecObj();
 }
@@ -969,17 +966,19 @@ BUILTIN_PROC_DEF(is_null) {
 
 BUILTIN_PROC_DEF(is_list) {
     ARGS_EXACTLY_ONE;
+    if (args->car == empty_list)
+        return new BoolObj(true);
     if (!args->car->is_cons_obj())
         return new BoolObj(false);
-    for (Cons *ptr = TO_CONS(args->car); ptr != empty_list;)
+    args = TO_CONS(args->car);
+    EvalObj *nptr;
+    for (;;)
     {
-        EvalObj *cdr = ptr->cdr;
-        if (!cdr->is_cons_obj())
-            return new BoolObj(false);
-        else
-            ptr = TO_CONS(cdr);
+        if ((nptr = args->cdr)->is_cons_obj())
+            args = TO_CONS(nptr);
+        else break;
     }
-    return new BoolObj(true);
+    return new BoolObj(args->cdr == empty_list);
 }
 
 BUILTIN_PROC_DEF(num_exact) {
@@ -998,6 +997,7 @@ BUILTIN_PROC_DEF(num_inexact) {
 
 
 BUILTIN_PROC_DEF(display) {
+    ARGS_EXACTLY_ONE;
     printf("%s\n", args->car->ext_repr().c_str());
     return new UnspecObj();
 }
diff --git a/main.cpp b/main.cpp
index 68f6c33..2e4d294 100644
--- a/main.cpp
+++ b/main.cpp
@@ -17,7 +17,7 @@ void tree_print(Cons *ptr) {
 #endif
 
 int main() {
-    //freopen("in", "r", stdin);
+//    freopen("in.scm", "r", stdin);
     Tokenizor *tk = new Tokenizor();
     ASTGenerator *ast = new ASTGenerator();
     Evaluator *eval = new Evaluator();
diff --git a/robust_test.scm b/robust_test.scm
new file mode 100644
index 0000000..08976a0
--- /dev/null
+++ b/robust_test.scm
@@ -0,0 +1,136 @@
+(+)
+(-)
+(*)
+(/)
+(+ 0)
+(- 0)
+(* 0)
+(/ 0)
+(<)
+(>)
+(=)
+(< 1)
+(> 1)
+(= 1)
+(+ 0 . 0)
+(+ . 0)
+(- 0 . 0)
+(- . 0)
+(< 0 . 0)
+(< . 0)
+
+(+ 0 'a)
+(- 0 'a)
+(* 0 'a)
+(/ 0 'a)
+(< #f)
+(> #f)
+(= #f)
+
+(exact?)
+(exact? 'a)
+(exact? 1 2)
+(exact? . 0)
+(exact? 0 . 0)
+
+(inexact?)
+(inexact? 'b)
+(inexact? 1 2)
+(inexact? . 0)
+(inexact? 0 . 0)
+
+(not)
+(not 1 2)
+(not 1)
+(not #f)
+(not '())
+(not . 0)
+(not 0 . 0)
+
+(boolean?)
+(boolean? 1 2)
+(boolean? 1)
+(boolean? #t)
+(boolean? . 0)
+(boolean? 0 . 0)
+
+(pair?)
+(pair? 1 2)
+(pair? '())
+(pair? (cons 1 2))
+(pair? '(3 . 4))
+(pair? 3)
+(pair? . 0)
+(pair? 0 . 0)
+
+(cons)
+(cons 1)
+(cons 1 2 3)
+(cons 'a '())
+(cons . 0)
+(cons 0 . 0)
+
+
+(define t (cons 'a '()))
+
+(car)
+(car 1)
+(car 1 2)
+(car '())
+(car t)
+(car . 0)
+(car 0 . 0)
+
+(cdr)
+(cdr 1)
+(cdr 1 2)
+(cdr '())
+(cdr t)
+(cdr . 0)
+(cdr 0 . 0)
+
+(set-car!)
+(set-car! 1)
+(set-car! 1 2)
+(set-car! t '())
+t
+(set-car! . 0)
+(set-car! 0 . 0)
+
+(set-cdr!)
+(set-cdr! 1)
+(set-cdr! 1 2)
+(set-cdr! t 'a)
+t
+(set-cdr! . 0)
+(set-cdr! 0 . 0)
+
+(null?)
+(null? 1 2)
+(null? 1)
+(null? '())
+(null? #f)
+(null? . 0)
+(null? 0 . 0)
+
+(list?)
+(list? 1 2)
+(list? '())
+(list? t)
+(set-cdr! t '())
+t
+(list? t)
+(list? . 0)
+(list? 0 . 0)
+
+(list)
+(list 1)
+(list 1 2)
+(list . 0)
+(list 0 . 0)
+
+(display)
+(display 1 2)
+(display . 0)
+(display 0 . 0)
+(display t)