From f0cf9e4d5cd358c7ac3759b9a1f47f07daf74104 Mon Sep 17 00:00:00 2001 From: Teddy Date: Thu, 8 Aug 2013 12:03:04 +0800 Subject: eqv? is implemented --- builtin.cpp | 33 +++++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) (limited to 'builtin.cpp') 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(obj1)->val == + static_cast(obj2)->val); + if (otype & CLS_SYM_OBJ) + return new BoolObj( + static_cast(obj1)->val == + static_cast(obj2)->val); + if (otype & CLS_NUM_OBJ) + { + NumObj *num1 = static_cast(obj1); + NumObj *num2 = static_cast(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(obj1)->ch == + static_cast(obj2)->ch); // (char=?) + return new BoolObj(obj1 == obj2); +} + BUILTIN_PROC_DEF(display) { ARGS_EXACTLY_ONE; printf("%s\n", args->car->ext_repr().c_str()); -- cgit v1.2.3