aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--builtin.cpp33
-rw-r--r--builtin.h2
-rw-r--r--eval.cpp3
-rw-r--r--model.cpp8
-rw-r--r--model.h3
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;