From f0cf9e4d5cd358c7ac3759b9a1f47f07daf74104 Mon Sep 17 00:00:00 2001
From: Teddy <ted.sybil@gmail.com>
Date: Thu, 8 Aug 2013 12:03:04 +0800
Subject: eqv? is implemented

---
 builtin.cpp | 33 +++++++++++++++++++++++++++++++++
 builtin.h   |  2 ++
 eval.cpp    |  3 +++
 model.cpp   |  8 ++++++--
 model.h     |  3 +++
 5 files changed, 47 insertions(+), 2 deletions(-)

diff --git a/builtin.cpp b/builtin.cpp
index 573159a..491d1ae 100644
--- a/builtin.cpp
+++ b/builtin.cpp
@@ -1211,6 +1211,39 @@ BUILTIN_PROC_DEF(list_tail) {
         return ptr;
 }
 
+BUILTIN_PROC_DEF(is_eqv) {
+    ARGS_EXACTLY_TWO;
+    EvalObj *obj1 = args->car;
+    EvalObj *obj2 = TO_CONS(args->cdr)->car;
+    ClassType otype = obj1->get_otype();
+
+    if (otype != obj2->get_otype()) return new BoolObj(false);
+    if (otype & CLS_BOOL_OBJ)
+        return new BoolObj(
+            static_cast<BoolObj*>(obj1)->val == 
+            static_cast<BoolObj*>(obj2)->val);
+    if (otype & CLS_SYM_OBJ)
+        return new BoolObj(
+            static_cast<SymObj*>(obj1)->val ==
+            static_cast<SymObj*>(obj2)->val);
+    if (otype & CLS_NUM_OBJ)
+    {
+        NumObj *num1 = static_cast<NumObj*>(obj1);
+        NumObj *num2 = static_cast<NumObj*>(obj2);
+        if (num1->is_exact() != num2->is_exact())
+            return new BoolObj(false);
+        if (num1->level < num2->level)
+            return new BoolObj(num1->eq(num1->convert(num2)));
+        else
+            return new BoolObj(num2->eq(num2->convert(num1)));
+    }
+    if (otype & CLS_CHAR_OBJ)
+        return new BoolObj(
+            static_cast<CharObj*>(obj1)->ch ==
+            static_cast<CharObj*>(obj2)->ch);    // (char=?)
+    return new BoolObj(obj1 == obj2);
+}
+
 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 2756d18..11b0d92 100644
--- a/builtin.h
+++ b/builtin.h
@@ -265,6 +265,8 @@ BUILTIN_PROC_DEF(append);
 BUILTIN_PROC_DEF(reverse);
 BUILTIN_PROC_DEF(list_tail);
 
+BUILTIN_PROC_DEF(is_eqv);
+
 BUILTIN_PROC_DEF(display);
 
 
diff --git a/eval.cpp b/eval.cpp
index 50f14bf..08f14f4 100644
--- a/eval.cpp
+++ b/eval.cpp
@@ -52,6 +52,9 @@ void Evaluator::add_builtin_routines() {
     ADD_BUILTIN_PROC("reverse", reverse);
     ADD_BUILTIN_PROC("list-tail", list_tail);
 
+    ADD_BUILTIN_PROC("eqv?", is_eqv);
+    ADD_BUILTIN_PROC("eq?", is_eqv);
+
     ADD_BUILTIN_PROC("display", display);
 }
 
diff --git a/model.cpp b/model.cpp
index 389f657..29f9e68 100644
--- a/model.cpp
+++ b/model.cpp
@@ -52,6 +52,10 @@ bool EvalObj::is_bool_obj() {
     return otype & CLS_BOOL_OBJ;
 }
 
+ClassType EvalObj::get_otype() {
+    return otype;
+}
+
 #ifdef DEBUG
 string EvalObj::_debug_repr() {
     return ext_repr();
@@ -196,11 +200,11 @@ NumObj::NumObj(NumLvl _level, bool _exactness) :
 
 bool NumObj::is_exact() { return exactness; }
 
-StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ), str(_str) {}
+StrObj::StrObj(string _str) : EvalObj(CLS_SIM_OBJ | CLS_STR_OBJ), str(_str) {}
 
 string StrObj::ext_repr() { return str; }
 
-CharObj::CharObj(char _ch) : EvalObj(CLS_SIM_OBJ), ch(_ch) {}
+CharObj::CharObj(char _ch) : EvalObj(CLS_SIM_OBJ | CLS_CHAR_OBJ), ch(_ch) {}
 
 CharObj *CharObj::from_string(string repr) {
     int len = repr.length();
diff --git a/model.h b/model.h
index 9de41fc..9afbf53 100644
--- a/model.h
+++ b/model.h
@@ -25,6 +25,8 @@ const int CLS_SYM_OBJ = 1 << 2;
 const int CLS_OPT_OBJ = 1 << 3;
 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;
 
 
 #define TO_CONS(ptr) \
@@ -99,6 +101,7 @@ class EvalObj : public FrameObj {
         bool is_num_obj();
         /** Check if the object is a boolean */
         bool is_bool_obj();
+        ClassType get_otype();
         virtual void prepare(Cons *pc);
         /** Any EvalObj has its external representation */
         virtual string ext_repr() = 0;  
-- 
cgit v1.2.3