From dcb5b448cd6b936b91663e94effbdc2a6bb25bd2 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 7 Dec 2013 06:29:29 -0800
Subject: [PATCH] add pic_equal_p

---
 include/picrin.h    |  2 ++
 piclib/built-in.scm | 10 ----------
 src/bool.c          | 32 ++++++++++++++++++++++++++++++++
 3 files changed, 34 insertions(+), 10 deletions(-)

diff --git a/include/picrin.h b/include/picrin.h
index ebf43a7b..9022d9a6 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -102,6 +102,8 @@ int pic_get_args(pic_state *, const char *, ...);
 void pic_defun(pic_state *, const char *, pic_func_t);
 void pic_defmacro(pic_state *, const char *, struct pic_proc *);
 
+bool pic_equal_p(pic_state *, pic_value, pic_value);
+
 pic_sym pic_intern_cstr(pic_state *, const char *);
 const char *pic_symbol_name(pic_state *, pic_sym);
 
diff --git a/piclib/built-in.scm b/piclib/built-in.scm
index 89d65e84..27351492 100644
--- a/piclib/built-in.scm
+++ b/piclib/built-in.scm
@@ -260,16 +260,6 @@
 (define-macro (unless test . exprs)
   (list 'if test #f (cons 'begin exprs)))
 
-(define (equal? x y)
-  (cond
-   ((eqv? x y)
-    #t)
-   ((and (pair? x) (pair? y))
-    (and (equal? (car x) (car y))
-	 (equal? (cdr x) (cdr y))))
-   (else
-    #f)))
-
 (define (member obj list . opts)
   (let ((compare (if (null? opts) equal? (car opts))))
     (if (null? list)
diff --git a/src/bool.c b/src/bool.c
index faacf3a8..3051a1b4 100644
--- a/src/bool.c
+++ b/src/bool.c
@@ -1,6 +1,27 @@
 #include <string.h>
 
 #include "picrin.h"
+#include "picrin/pair.h"
+
+bool
+pic_equal_p(pic_state *pic, pic_value x, pic_value y)
+{
+  enum pic_tt type;
+
+  if (pic_eqv_p(x, y))
+    return true;
+
+  type = pic_type(x);
+  if (type != pic_type(y))
+    return false;
+  switch (type) {
+  case PIC_TT_PAIR:
+    return pic_equal_p(pic, pic_car(pic, x), pic_car(pic, y))
+      && pic_equal_p(pic, pic_cdr(pic, x), pic_cdr(pic, y));
+  default:
+    return false;
+  }
+}
 
 static pic_value
 pic_bool_eq_p(pic_state *pic)
@@ -22,6 +43,16 @@ pic_bool_eqv_p(pic_state *pic)
   return pic_bool_value(pic_eqv_p(x, y));
 }
 
+static pic_value
+pic_bool_equal_p(pic_state *pic)
+{
+  pic_value x, y;
+
+  pic_get_args(pic, "oo", &x, &y);
+
+  return pic_bool_value(pic_equal_p(pic, x, y));
+}
+
 /* TODO: replace it with native opcode */
 static pic_value
 pic_bool_not(pic_state *pic)
@@ -48,6 +79,7 @@ pic_init_bool(pic_state *pic)
 {
   pic_defun(pic, "eq?", pic_bool_eq_p);
   pic_defun(pic, "eqv?", pic_bool_eqv_p);
+  pic_defun(pic, "equal?", pic_bool_equal_p);
 
   pic_defun(pic, "not", pic_bool_not);
   pic_defun(pic, "boolean?", pic_bool_boolean_p);