added `and` operator

9 files changed, 204 insertions, 129 deletions

diff --git a/Makefile b/Makefile
index 07feba0..eddc4b8 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 -g -pg -DGMP_SUPPORT -Wall -Wextra -Wconversion
 
 clean:
 	rm -f *.o
diff --git a/builtin.cpp b/builtin.cpp
index 27b3ee7..a5d8b15 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -30,15 +30,6 @@ static const int NUM_LVL_INT = 3;
     if (args == empty_list) \
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS)
 
-bool is_list(Pair *ptr) {
-    if (ptr == empty_list) return true;
-    EvalObj *nptr; 
-    for (;;) 
-        if ((nptr = ptr->cdr)->is_pair_obj()) 
-            ptr = TO_PAIR(nptr); 
-        else break; 
-    return ptr->cdr == empty_list;
-}
 
 string double_to_str(double val, bool force_sign = false) {
     stringstream ss;
@@ -95,7 +86,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
     CompNumObj *CompNumObj::from_string(string repr) {
         // spos: the position of the last sign
         // ipos: the position of i
-        int spos = -1, ipos = -1;
+        long long spos = -1, ipos = -1;
         size_t len = repr.length();
         bool sign;
         for (size_t i = 0; i < len; i++)
@@ -117,7 +108,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
         if (spos > 0)
         {
             string real_str = repr.substr(0, spos);
-            if (int_ptr = IntNumObj::from_string(real_str))
+            if ((int_ptr = IntNumObj::from_string(real_str)))
 #ifndef GMP_SUPPORT
                 real = int_ptr->val;
 #else
@@ -136,7 +127,7 @@ CompNumObj::CompNumObj(double _real, double _imag) :
         if (ipos > spos + 1)
         {
             string imag_str = repr.substr(spos + 1, ipos - spos - 1);
-            if (int_ptr = IntNumObj::from_string(imag_str))
+            if ((int_ptr = IntNumObj::from_string(imag_str)))
 #ifndef GMP_SUPPORT
                 imag = int_ptr->val;
 #else
@@ -854,7 +845,6 @@ Pair *SpecialOptEval::call(ArgList *args, Environment * &envt,
         TO_PAIR(args->cdr)->cdr != empty_list)
         throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS);
     Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
-    Pair *pc = static_cast<Pair*>(ret_addr->car);
     if (state)
     {
         *top_ptr++ = TO_PAIR(args->cdr)->car;
@@ -872,6 +862,54 @@ ReprCons *SpecialOptEval::get_repr_cons() {
     return new ReprStr("#<Builtin Macro: eval>"); 
 }
 
+SpecialOptAnd::SpecialOptAnd() : SpecialOptObj("and") {}
+
+void SpecialOptAnd::prepare(Pair *pc) {
+    CHECK_COM(pc);
+    if (pc->cdr != empty_list)
+    {
+        pc->next = TO_PAIR(pc->cdr);
+        pc->next->next = NULL;
+    }
+}
+
+Pair *SpecialOptAnd::call(ArgList *args, Environment * &envt, 
+        Continuation * &cont, FrameObj ** &top_ptr) {
+    Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+    Pair *pc = static_cast<Pair*>(ret_addr->car);
+    if (args->cdr == empty_list)
+    {
+        *top_ptr++ = new BoolObj(true);
+        return ret_addr->next;
+    }
+    EvalObj *ret = TO_PAIR(args->cdr)->car;
+    if (ret->is_true())
+    {
+        if (pc->next->cdr == empty_list) // the last member
+        {
+            *top_ptr++ = ret;
+            return ret_addr->next;
+        }
+        else
+        {
+            top_ptr += 2;
+            pc->next = TO_PAIR(pc->next->cdr);
+            pc->next->next = NULL;
+            return pc->next;
+        }
+    }
+    else
+    {
+        *top_ptr++ = ret;
+        return ret_addr->next;
+    }
+    throw NormalError(INT_ERR);
+}
+
+ReprCons *SpecialOptAnd::get_repr_cons() { 
+    return new ReprStr("#<Builtin Macro: and>"); 
+}
+
 BUILTIN_PROC_DEF(make_pair) {
     ARGS_EXACTLY_TWO;
     return new Pair(args->car, TO_PAIR(args->cdr)->car);
@@ -893,9 +931,8 @@ BUILTIN_PROC_DEF(pair_cdr) {
     return TO_PAIR(args->car)->cdr;
 }
 
+
 BUILTIN_PROC_DEF(make_list) {
-    if (!is_list(args))
-        throw TokenError(name, RUN_ERR_WRONG_NUM_OF_ARGS); 
     return args;
 }
 
@@ -1227,7 +1264,7 @@ BUILTIN_PROC_DEF(is_eqv) {
     ARGS_EXACTLY_TWO;
     EvalObj *obj1 = args->car;
     EvalObj *obj2 = TO_PAIR(args->cdr)->car;
-    ClassType otype = obj1->get_otype();
+    int otype = obj1->get_otype();
 
     if (otype != obj2->get_otype()) return new BoolObj(false);
     if (otype & CLS_BOOL_OBJ)
@@ -1353,11 +1390,15 @@ do { \
             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)
         {
diff --git a/builtin.h b/builtin.h
index 3f6fa29..d4ad86f 100644
--- a/builtin.h
+++ b/builtin.h
@@ -8,7 +8,6 @@
 using std::string;
 
 const int EQUAL_QUEUE_SIZE = 262144;
-bool is_list(Pair *ptr);
 
 /** @class InexactNumObj
  * Inexact number implementation (using doubles)
@@ -234,6 +233,21 @@ class SpecialOptEval: public SpecialOptObj {
         ReprCons *get_repr_cons();
 };
 
+/** @class SpecialOptAnd
+ * The implementation of `and` operator
+ */
+class SpecialOptAnd: public SpecialOptObj {
+    private:
+        unsigned char state; /**< 0 for prepared, 1 for pre_called */
+    public:
+        SpecialOptAnd();
+        void prepare(Pair *pc);
+        Pair *call(ArgList *args, Environment * &envt, 
+                    Continuation * &cont, FrameObj ** &top_ptr);
+
+        ReprCons *get_repr_cons();
+};
+
 #define BUILTIN_PROC_DEF(func)\
     EvalObj *(func)(ArgList *args, const string &name)
 
diff --git a/eval.cpp b/eval.cpp
index fddd14d..63f5f96 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -21,6 +21,7 @@ void Evaluator::add_builtin_routines() {
     ADD_ENTRY("set!", new SpecialOptSet());
     ADD_ENTRY("quote", new SpecialOptQuote());
     ADD_ENTRY("eval", new SpecialOptEval());
+    ADD_ENTRY("and", new SpecialOptAnd());
 
     ADD_BUILTIN_PROC("+", num_add);
     ADD_BUILTIN_PROC("-", num_sub);
diff --git a/main.cpp b/main.cpp
index db635e8..8f7683f 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 f5ed609..a00a765 100644
--- a/model.cpp
+++ b/model.cpp
@@ -109,65 +109,65 @@ Pair::Pair(EvalObj *_car, EvalObj *_cdr) :
     EvalObj(CLS_PAIR_OBJ), car(_car), cdr(_cdr), 
     next(NULL) {}
 
-ReprCons *Pair::get_repr_cons() {
-    return new PairReprCons(this, this);
-}
+    ReprCons *Pair::get_repr_cons() {
+        return new PairReprCons(this, this);
+    }
 
 RetAddr::RetAddr(Pair *_addr) : FrameObj(CLS_RET_ADDR), addr(_addr) {}
 
 ParseBracket::ParseBracket(unsigned char _btype) : 
     FrameObj(CLS_SIM_OBJ | CLS_PAR_BRA), btype(_btype) {}
 
-UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {}
+    UnspecObj::UnspecObj() : EvalObj(CLS_SIM_OBJ) {}
 
-ReprCons *UnspecObj::get_repr_cons() { 
-    return new ReprStr("#<Unspecified>");
-}
+    ReprCons *UnspecObj::get_repr_cons() { 
+        return new ReprStr("#<Unspecified>");
+    }
 
 SymObj::SymObj(const string &str) : 
     EvalObj(CLS_SIM_OBJ | CLS_SYM_OBJ), val(str) {}
 
-ReprCons *SymObj::get_repr_cons() { 
-    return new ReprStr(val); 
-}
+    ReprCons *SymObj::get_repr_cons() { 
+        return new ReprStr(val); 
+    }
 
 OptObj::OptObj() : EvalObj(CLS_SIM_OBJ | CLS_OPT_OBJ) {}
 
 ProcObj::ProcObj(Pair *_body, 
-                    Environment *_envt, 
-                    EvalObj *_params) :
-    OptObj(), body(_body), envt(_envt), params(_params) {}
-
-Pair *ProcObj::call(ArgList *args, Environment * &genvt,
-                    Continuation * &cont, FrameObj ** &top_ptr) {
-    // Create a new continuation
-    // static_cast see `call` invocation in eval.cpp
-    Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
-    Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
-    // Create local env and recall the closure
-    Environment *_envt = new Environment(envt);   
-    // static_cast<SymObj*> because the params is already checked
-    EvalObj *ppar, *nptr;
-    for (ppar = params;
-            ppar->is_pair_obj(); 
-            ppar = TO_PAIR(ppar)->cdr)
-    {
-        if ((nptr = args->cdr) != empty_list)
-            args = TO_PAIR(nptr);
-        else break;
-        _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
-    }
+        Environment *_envt, 
+        EvalObj *_params) :
+    OptObj(), body(_body), params(_params), envt(_envt) {}
+
+    Pair *ProcObj::call(ArgList *args, Environment * &genvt,
+            Continuation * &cont, FrameObj ** &top_ptr) {
+        // Create a new continuation
+        // static_cast see `call` invocation in eval.cpp
+        Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+        Continuation *_cont = new Continuation(genvt, ret_addr, cont, body);
+        // Create local env and recall the closure
+        Environment *_envt = new Environment(envt);   
+        // static_cast<SymObj*> because the params is already checked
+        EvalObj *ppar, *nptr;
+        for (ppar = params;
+                ppar->is_pair_obj(); 
+                ppar = TO_PAIR(ppar)->cdr)
+        {
+            if ((nptr = args->cdr) != empty_list)
+                args = TO_PAIR(nptr);
+            else break;
+            _envt->add_binding(static_cast<SymObj*>(TO_PAIR(ppar)->car), args->car);
+        }
 
-    if (ppar->is_sym_obj())
-        _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
-    else if (args->cdr != empty_list || ppar != empty_list)
-        throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
+        if (ppar->is_sym_obj())
+            _envt->add_binding(static_cast<SymObj*>(ppar), args->cdr); // (... . var_n)
+        else if (args->cdr != empty_list || ppar != empty_list)
+            throw TokenError("", RUN_ERR_WRONG_NUM_OF_ARGS);
 
-    genvt = _envt;
-    cont = _cont;                   
-    *top_ptr++ = new RetAddr(NULL);   // Mark the entrance of a cont
-    return body;                    // Move pc to the proc entry point
-}
+        genvt = _envt;
+        cont = _cont;                   
+        *top_ptr++ = new RetAddr(NULL);   // Mark the entrance of a cont
+        return body;                    // Move pc to the proc entry point
+    }
 
 ReprCons *ProcObj::get_repr_cons() { 
     return new ReprStr("#<Procedure>"); 
@@ -194,20 +194,20 @@ BoolObj *BoolObj::from_string(string repr) {
 }
 
 NumObj::NumObj(NumLvl _level, bool _exactness) : 
-    EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), level(_level), exactness(_exactness) {}
+    EvalObj(CLS_SIM_OBJ | CLS_NUM_OBJ), exactness(_exactness), level(_level) {}
 
-bool NumObj::is_exact() { return exactness; }
+    bool NumObj::is_exact() { return exactness; }
 
-StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {}
+    StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {}
 
-ReprCons *StrObj::get_repr_cons() { 
-    return new ReprStr(str); 
-}
+    ReprCons *StrObj::get_repr_cons() { 
+        return new ReprStr(str); 
+    }
 
 CharObj::CharObj(char _ch) : EvalObj(CLS_SIM_OBJ | CLS_CHAR_OBJ), ch(_ch) {}
 
 CharObj *CharObj::from_string(string repr) {
-    int len = repr.length();
+    size_t len = repr.length();
     if (len < 2) return NULL;
     if (repr[0] != '#' || repr[1] != '\\') return NULL;
     if (len == 3) return new CharObj(repr[2]);
@@ -231,7 +231,7 @@ EvalObj *VecObj::get_obj(int idx) {
     return vec[idx];
 }
 
-int VecObj::get_size() { 
+size_t VecObj::get_size() { 
     return vec.end() - vec.begin();
 }
 
@@ -257,13 +257,13 @@ StrObj *StrObj::from_string(string repr) {
 BuiltinProcObj::BuiltinProcObj(BuiltinProc f, string _name) :
     OptObj(), handler(f), name(_name) {}
 
-Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt,
-                                Continuation * &cont, FrameObj ** &top_ptr) {
+    Pair *BuiltinProcObj::call(ArgList *args, Environment * &envt,
+            Continuation * &cont, FrameObj ** &top_ptr) {
 
-    Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
-    *top_ptr++ = handler(TO_PAIR(args->cdr), name);
-    return ret_addr->next;          // Move to the next instruction
-}
+        Pair *ret_addr = static_cast<RetAddr*>(*top_ptr)->addr;
+        *top_ptr++ = handler(TO_PAIR(args->cdr), name);
+        return ret_addr->next;          // Move to the next instruction
+    }
 
 ReprCons *BuiltinProcObj::get_repr_cons() { 
     return new ReprStr("#<Builtin Procedure: " + name + ">");
@@ -295,68 +295,79 @@ EvalObj *Environment::get_obj(EvalObj *obj) {
 Continuation::Continuation(Environment *_envt, Pair *_pc, 
         Continuation *_prev_cont, 
         Pair *_proc_body) : 
-    envt(_envt), pc(_pc), prev_cont(_prev_cont), 
+    prev_cont(_prev_cont), envt(_envt), pc(_pc), 
     proc_body(_proc_body) {}
 
-ReprCons::ReprCons(bool _done, EvalObj *_ori) : done(_done), ori(_ori) {}
-ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
-EvalObj *ReprStr::next(const string &prev) {
-    throw NormalError(INT_ERR);
-}
+    ReprCons::ReprCons(bool _done, EvalObj *_ori) : ori(_ori), done(_done) {}
+    ReprStr::ReprStr(string _repr) : ReprCons(true) { repr = _repr; }
+    EvalObj *ReprStr::next(const string &prev) {
+        throw NormalError(INT_ERR);
+    }
 
 PairReprCons::PairReprCons(Pair *_ptr, EvalObj *_ori) : 
-    ReprCons(false, _ori), ptr(_ptr), state(0) {}
+    ReprCons(false, _ori), state(0), ptr(_ptr) {}
 
-EvalObj *PairReprCons::next(const string &prev) {
-    repr += prev;
-    EvalObj *res;
-    if (state == 0)
-    {
-        state = 1;
-        res = TO_PAIR(ptr)->car;
-        if (res->is_pair_obj()) 
-            repr += "(";
-        return res;
-    }
-    else if (state == 1)
-    {   
-        state = 2;
-        if (TO_PAIR(ptr)->car->is_pair_obj()) 
-            repr += ")";
-        ptr = TO_PAIR(ptr)->cdr;
-        if (ptr == empty_list)
+    EvalObj *PairReprCons::next(const string &prev) {
+        repr += prev;
+        EvalObj *res;
+        if (state == 0)
+        {
+            state = 1;
+            res = TO_PAIR(ptr)->car;
+            if (res->is_pair_obj()) 
+                repr += "(";
+            return res;
+        }
+        else if (state == 1)
+        {   
+            state = 2;
+            if (TO_PAIR(ptr)->car->is_pair_obj()) 
+                repr += ")";
+            ptr = TO_PAIR(ptr)->cdr;
+            if (ptr == empty_list)
+                return NULL;
+            repr += " ";
+            if (ptr->is_simple_obj())
+                repr += ". ";
+            return ptr;
+        }
+        else 
+        {
             return NULL;
-        repr += " ";
-        if (ptr->is_simple_obj())
-            repr += ". ";
-        return ptr;
-    }
-    else 
-    {
-        return NULL;
+        }
     }
-}
 
 VectReprCons::VectReprCons(VecObj *_ptr, EvalObj *_ori) :
     ReprCons(false, _ori), ptr(_ptr), idx(0) { repr = "#("; }
 
-EvalObj *VectReprCons::next(const string &prev) {
-    repr += prev;
+    EvalObj *VectReprCons::next(const string &prev) {
+        repr += prev;
 
-    if (idx && ptr->get_obj(idx - 1)->is_pair_obj())
-        repr += ")";
+        if (idx && ptr->get_obj(idx - 1)->is_pair_obj())
+            repr += ")";
 
-    if (idx == ptr->get_size())
-    {
-        repr += ")";
-        return NULL;
-    }
-    else 
-    {
-        if (idx) repr += " ";
-        EvalObj *res = ptr->get_obj(idx++);
-        if (res->is_pair_obj())
-            repr += "(";
-        return res;
+        if (idx == ptr->get_size())
+        {
+            repr += ")";
+            return NULL;
+        }
+        else 
+        {
+            if (idx) repr += " ";
+            EvalObj *res = ptr->get_obj(idx++);
+            if (res->is_pair_obj())
+                repr += "(";
+            return res;
+        }
     }
-}
+
+bool is_list(Pair *ptr) {
+    if (ptr == empty_list) return true;
+    EvalObj *nptr;  
+    for (;;)  
+        if ((nptr = ptr->cdr)->is_pair_obj())  
+            ptr = TO_PAIR(nptr);  
+        else break;  
+    return ptr->cdr == empty_list;
+} 
+
diff --git a/model.h b/model.h
index a4c6a1f..88b29cb 100644
--- a/model.h
+++ b/model.h
@@ -181,7 +181,7 @@ class VecObj;
 class VectReprCons : public ReprCons {
     private:
         VecObj *ptr;
-        int idx;
+        size_t idx;
     public:
         VectReprCons(VecObj *ptr, EvalObj *ori);
         EvalObj *next(const string &prev);
@@ -377,7 +377,7 @@ class VecObj: public EvalObj {
         EvalObjVec vec;
         /** Construct a vector object */
         VecObj();
-        int get_size();
+        size_t get_size();
         EvalObj *get_obj(int idx);
         /** Resize the vector */
         void resize(int new_size);
@@ -434,4 +434,6 @@ class Continuation {
                 Pair *proc_body);
 };
 
+bool is_list();
+
 #endif
diff --git a/parser.cpp b/parser.cpp
index 97482d4..21db112 100644
--- a/parser.cpp
+++ b/parser.cpp
@@ -45,7 +45,7 @@ void Tokenizor::set_stream(FILE *_stream) {
 
 void str_to_lower(string &str) {
     size_t len = str.length();
-    for (int i = 0; i < len; i++)
+    for (size_t i = 0; i < len; i++)
         if ('A' <= str[i] && str[i] <= 'Z')
             str[i] -= 'A' - 'a';
 }
diff --git a/robust_test.scm b/robust_test.scm
index 9f5c798..0e989b8 100644
--- a/robust_test.scm
+++ b/robust_test.scm
@@ -166,3 +166,9 @@ t
 (lambda () '(1 2 3))
 (lambda () 1 2 3)
 (lambda #() 1)
+
+(define src
+  '(define g (lambda (x) (if (= x 5) 0 ((lambda () (display x) (g (+ x 1))))))))
+src
+(eval src)
+(eval '(g 0))