gc detect in list-specific built-ins, proper numeric conversion

5 files changed, 128 insertions, 75 deletions

diff --git a/builtin.cpp b/builtin.cpp
index 2cd738a..4116501 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -113,10 +113,10 @@ do \
         throw TokenError("a number", RUN_ERR_WRONG_TYPE); \
 } while (0)
 
-#define CHECK_INT(ptr) \
+#define CHECK_EXACT(ptr) \
 do \
 { \
-    if ((ptr)->level != NUM_LVL_INT) \
+    if (!(static_cast<NumObj*>(ptr))->is_exact()) \
         throw TokenError("an integer", RUN_ERR_WRONG_TYPE); \
 } while (0)
 
@@ -1031,18 +1031,23 @@ BUILTIN_PROC_DEF(length) {
 
 Pair *copy_list(Pair *src, EvalObj * &tail) {
     if (src == empty_list)
+    {
+        puts("oops");
         throw NormalError(INT_ERR);
+    }
     EvalObj* nptr;
     Pair head(NULL, NULL);
     tail = &head;
     for (;;)
     {
-        TO_PAIR(tail)->cdr = new Pair(*src);
+        gc.attach(TO_PAIR(tail)->cdr = new Pair(*src));
         tail = TO_PAIR(TO_PAIR(tail)->cdr);
+        gc.attach(TO_PAIR(tail)->car);
         if ((nptr = src->cdr)->is_pair_obj())
             src = TO_PAIR(nptr);
         else break;
     }
+    gc.attach(TO_PAIR(tail)->cdr);
     return TO_PAIR(head.cdr);
 }
 
@@ -1065,9 +1070,9 @@ BUILTIN_PROC_DEF(append) {
                 if (prev->cdr != empty_list)
                     throw TokenError("empty list", RUN_ERR_WRONG_TYPE);
                 if (args->car->is_pair_obj())
-                    prev->cdr = copy_list(TO_PAIR(args->car), tail);
+                    gc.attach(prev->cdr = copy_list(TO_PAIR(args->car), tail));
                 else
-                    prev->cdr = args->car;
+                    gc.attach(prev->cdr = args->car);
             }
             else
                 throw TokenError("a pair", RUN_ERR_WRONG_TYPE);
@@ -1091,10 +1096,11 @@ BUILTIN_PROC_DEF(reverse) {
 BUILTIN_PROC_DEF(list_tail) {
     ARGS_EXACTLY_TWO;
     EvalObj *sec = TO_PAIR(args->cdr)->car;
-    if (!sec->is_num_obj() ||
-            static_cast<NumObj*>(sec)->level != NUM_LVL_INT)
-        throw TokenError("an exact integer", RUN_ERR_WRONG_TYPE);
-    int i, k = static_cast<IntNumObj*>(sec)->get_i();
+    CHECK_NUMBER(sec);
+    CHECK_EXACT(sec);
+    IntNumObj *val = static_cast<ExactNumObj*>(sec)->to_int();
+    int i, k = val->get_i();
+    delete val;
     if (k < 0)
         throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
     EvalObj *ptr;
@@ -1311,41 +1317,56 @@ BUILTIN_PROC_DEF(num_abs) {
 
 BUILTIN_PROC_DEF(num_mod) {
     ARGS_EXACTLY_TWO;
-    CHECK_NUMBER(args->car);
-    CHECK_NUMBER(TO_PAIR(args->cdr)->car);
-    NumObj* a = static_cast<NumObj*>(args->car);
-    NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
-    CHECK_INT(a);
-    CHECK_INT(b);
-    NumObj* res = a->clone();
-    static_cast<IntNumObj*>(res)->mod(b);
-    return res;
+    EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car;
+    CHECK_NUMBER(first);
+    CHECK_NUMBER(second);
+
+    CHECK_EXACT(first);
+    CHECK_EXACT(second);
+
+    IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int();
+    IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int();
+
+    a->mod(b);
+
+    delete b;
+    return a;
 }
 
-BUILTIN_PROC_DEF(num_rem) {
+BUILTIN_PROC_DEF(num_quo) {
     ARGS_EXACTLY_TWO;
-    CHECK_NUMBER(args->car);
-    CHECK_NUMBER(TO_PAIR(args->cdr)->car);
-    NumObj* a = static_cast<NumObj*>(args->car);
-    NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
-    CHECK_INT(a);
-    CHECK_INT(b);
-    NumObj* res = a->clone();
-    static_cast<IntNumObj*>(res)->rem(b);
-    return res;
+    EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car;
+    CHECK_NUMBER(first);
+    CHECK_NUMBER(second);
+
+    CHECK_EXACT(first);
+    CHECK_EXACT(second);
+
+    IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int();
+    IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int();
+
+    a->div(b);
+
+    delete b;
+    return a;
 }
 
-BUILTIN_PROC_DEF(num_quo) {
+BUILTIN_PROC_DEF(num_rem) {
     ARGS_EXACTLY_TWO;
-    CHECK_NUMBER(args->car);
-    CHECK_NUMBER(TO_PAIR(args->cdr)->car);
-    NumObj* a = static_cast<NumObj*>(args->car);
-    NumObj* b = static_cast<NumObj*>(TO_PAIR(args->cdr)->car);
-    CHECK_INT(a);
-    CHECK_INT(b);
-    NumObj* res = a->clone();
-    static_cast<IntNumObj*>(res)->div(b);
-    return res;
+    EvalObj *first = args->car, *second = TO_PAIR(args->cdr)->car;
+    CHECK_NUMBER(first);
+    CHECK_NUMBER(second);
+
+    CHECK_EXACT(first);
+    CHECK_EXACT(second);
+
+    IntNumObj *a = static_cast<ExactNumObj*>(first)->to_int();
+    IntNumObj *b = static_cast<ExactNumObj*>(second)->to_int();
+
+    a->rem(b);
+
+    delete b;
+    return a;
 }
 
 BUILTIN_PROC_DEF(num_gcd) {
@@ -1354,11 +1375,13 @@ BUILTIN_PROC_DEF(num_gcd) {
     IntNumObj *opr; 
     for (;args != empty_list; args = TO_PAIR(args->cdr))
     {
-        CHECK_NUMBER(args->car);
-        CHECK_INT(static_cast<NumObj*>(args->car));
+        EvalObj *obj = args->car;
+        CHECK_NUMBER(obj);
+        CHECK_EXACT(obj);
 
-        opr = static_cast<IntNumObj*>(args->car);
+        opr = static_cast<ExactNumObj*>(obj)->to_int();
         res->gcd(opr);
+        delete opr;
     }
     return res;
 }
@@ -1369,11 +1392,13 @@ BUILTIN_PROC_DEF(num_lcm) {
     IntNumObj *opr; 
     for (;args != empty_list; args = TO_PAIR(args->cdr))
     {
-        CHECK_NUMBER(args->car);
-        CHECK_INT(static_cast<NumObj*>(args->car));
+        EvalObj *obj = args->car;
+        CHECK_NUMBER(obj);
+        CHECK_EXACT(obj);
 
-        opr = static_cast<IntNumObj*>(args->car);
+        opr = static_cast<ExactNumObj*>(obj)->to_int();
         res->lcm(opr);
+        delete opr;
     }
     return res;
 }
@@ -1435,11 +1460,12 @@ BUILTIN_PROC_DEF(string_eq) {
 
 BUILTIN_PROC_DEF(make_vector) {
     ARGS_AT_LEAST_ONE;
-    if (!args->car->is_num_obj())
-        throw TokenError("a number", RUN_ERR_WRONG_TYPE);
-    if (static_cast<NumObj*>(args->car)->level != NUM_LVL_INT)
-        throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
-    ssize_t len = static_cast<IntNumObj*>(args->car)->get_i();
+    EvalObj *first = args->car;
+    CHECK_NUMBER(first);
+    CHECK_EXACT(first);
+    IntNumObj *val = static_cast<ExactNumObj*>(first)->to_int();
+    ssize_t len = val->get_i();
+    delete val;
     if (len < 0)
         throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
 
@@ -1467,9 +1493,12 @@ BUILTIN_PROC_DEF(vector_set) {
     args = TO_PAIR(args->cdr);
     if (args == empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
-    CHECK_NUMBER(args->car);
-    CHECK_INT(static_cast<NumObj*>(args->car));
-    ssize_t k = static_cast<IntNumObj*>(args->car)->get_i();
+    EvalObj *second = args->car;
+    CHECK_NUMBER(second);
+    CHECK_EXACT(second);
+    IntNumObj *val = static_cast<ExactNumObj*>(second)->to_int();
+    ssize_t k = val->get_i();
+    delete val;
     if (k < 0)
         throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
 
@@ -1496,9 +1525,12 @@ BUILTIN_PROC_DEF(vector_ref) {
     if (args->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
 
-    CHECK_NUMBER(args->car);
-    CHECK_INT(static_cast<NumObj*>(args->car));
-    ssize_t k = static_cast<IntNumObj*>(args->car)->get_i();
+    EvalObj *second = args->car;
+    CHECK_NUMBER(second);
+    CHECK_EXACT(second);
+    IntNumObj *val = static_cast<ExactNumObj*>(second)->to_int();
+    ssize_t k = val->get_i();
+    delete val;
     if (k < 0)
         throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
     return vect->get(k);
@@ -1523,9 +1555,12 @@ BUILTIN_PROC_DEF(gc_status) {
 
 BUILTIN_PROC_DEF(set_gc_resolve_threshold) {
     ARGS_EXACTLY_ONE;
-    CHECK_NUMBER(args->car);
-    CHECK_INT(static_cast<NumObj*>(args->car));
-    ssize_t s = static_cast<IntNumObj*>(args->car)->get_i();
+    EvalObj *first = args->car;
+    CHECK_NUMBER(first);
+    CHECK_EXACT(first);
+    IntNumObj *val = static_cast<ExactNumObj*>(first)->to_int();
+    ssize_t s = val->get_i();
+    delete val;
     if (s < 0)
         throw TokenError("a non-negative integer", RUN_ERR_WRONG_TYPE);
     gc.set_resolve_threshold(size_t(s));
diff --git a/main.cpp b/main.cpp
index 42c89b2..14e0e43 100644
--- a/main.cpp
+++ b/main.cpp
@@ -21,18 +21,19 @@ void load_file(const char *fname) {
         exit(0);
     }
     tk.set_stream(f);
+    Pair *tree;
     while (1)
     {
         try
         {
-            Pair *tree = ast.absorb(&tk);
+            tree = ast.absorb(&tk);
             if (!tree) break;
             EvalObj *ret = eval.run_expr(tree);
             gc.expose(ret);
         }
         catch (GeneralError &e)
         {
-            fprintf(stderr, "An error occured: %s\n", e.get_msg().c_str());
+            fprintf(stderr, "An error occured near [%s]: %s\n", tree->ext_repr().c_str(), e.get_msg().c_str());
         }
         gc.force();
         gc.cycle_resolve();
diff --git a/test/q.scm b/test/q.scm
index c1915a9..5b75ff6 100644
--- a/test/q.scm
+++ b/test/q.scm
@@ -68,12 +68,12 @@
 
 (display (queen 8))
 
-(define shl '())
-(define shr '())
-(define empty-bits '())
-(define res '())
-(define queen '())
-(set-gc-resolve-threshold! 0)   ; force cycle resolve
-(display "\n")
-(display (gc-status))
-
+;(define shl '())
+;(define shr '())
+;(define empty-bits '())
+;(define res '())
+;(define queen '())
+;(set-gc-resolve-threshold! 0)   ; force cycle resolve
+;(display "\n")
+;(display (gc-status))
+;
diff --git a/types.cpp b/types.cpp
index 3e5fd07..6371640 100644
--- a/types.cpp
+++ b/types.cpp
@@ -404,6 +404,7 @@ ReprCons *Continuation::get_repr_cons() {
 ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {}
 ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
 EvalObj *ReprStr::next(const string &prev) {
+    fprintf(stderr, "Oops in ReprStr::next\n");
     throw NormalError(INT_ERR);
 }
 
@@ -995,6 +996,12 @@ void RatNumObj::abs() {
 #endif
 }
 
+IntNumObj *RatNumObj::to_int() {
+    if (val.get_den() != 1)
+        throw TokenError("an integer", RUN_ERR_WRONG_TYPE);
+    return new IntNumObj(val.get_num());
+}
+
 ReprCons *RatNumObj::get_repr_cons() {
 #ifndef GMP_SUPPORT
     return new ReprStr(int_to_str(A) + "/" + int_to_str(B));
@@ -1088,15 +1095,15 @@ void IntNumObj::div(NumObj *_r) {
 }
 
 void IntNumObj::gcd(NumObj *_r) {
-    mpz_t g;
-    mpz_gcd(g, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t());
-    val = mpz_class(g);
+    mpz_gcd(val.get_mpz_t(), 
+            val.get_mpz_t(), 
+            static_cast<IntNumObj*>(_r)->val.get_mpz_t());
 }
 
 void IntNumObj::lcm(NumObj *_r) {
-    mpz_t l;
-    mpz_lcm(l, val.get_mpz_t(), static_cast<IntNumObj*>(_r)->val.get_mpz_t());
-    val = mpz_class(l);
+    mpz_lcm(val.get_mpz_t(), 
+            val.get_mpz_t(), 
+            static_cast<IntNumObj*>(_r)->val.get_mpz_t());
 }
 
 bool IntNumObj::lt(NumObj *_r) {
@@ -1120,6 +1127,10 @@ bool IntNumObj::eq(NumObj *_r) {
     return val == static_cast<IntNumObj*>(_r)->val;
 }
 
+IntNumObj* IntNumObj::to_int() {
+    return new IntNumObj(val);
+}
+
 ReprCons *IntNumObj::get_repr_cons() {
 #ifndef GMP_SUPPORT
     return new ReprStr(int_to_str(val));
diff --git a/types.h b/types.h
index 7db90f5..a3773e8 100644
--- a/types.h
+++ b/types.h
@@ -461,12 +461,14 @@ class RealNumObj: public InexactNumObj {/*{{{*/
 };/*}}}*/
 
 
+class IntNumObj;
 /** @class ExactNumObj
  * Exact number implementation (using gmp)
  */
 class ExactNumObj: public NumObj {/*{{{*/
     public:
         ExactNumObj(NumLvl level);
+        virtual IntNumObj *to_int() = 0;
 };/*}}}*/
 
 /** @class RatNumObj
@@ -482,6 +484,7 @@ class RatNumObj: public ExactNumObj {/*{{{*/
         mpq_class val;
         RatNumObj(mpq_class val);
         RatNumObj(const RatNumObj &ori);
+        IntNumObj *to_int();
 #endif
         NumObj *clone() const;
         /** Try to construct an RatNumObj object
@@ -501,6 +504,7 @@ class RatNumObj: public ExactNumObj {/*{{{*/
         bool le(NumObj *r);
         bool ge(NumObj *r);
         bool eq(NumObj *r);
+
         ReprCons *get_repr_cons();
 };/*}}}*/
 
@@ -520,6 +524,7 @@ class IntNumObj: public ExactNumObj {/*{{{*/
         IntNumObj(mpz_class val);
         int get_i();
         /** Copy constructor */
+        IntNumObj *to_int();
         IntNumObj(const IntNumObj &ori);
 #endif
         NumObj *clone() const;
@@ -546,6 +551,7 @@ class IntNumObj: public ExactNumObj {/*{{{*/
         bool le(NumObj *r);
         bool ge(NumObj *r);
         bool eq(NumObj *r);
+
         ReprCons *get_repr_cons();
 };/*}}}*/