From ad2434cde7cf501a9a1d785188a801e91a34a0ea Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 19 Jul 2014 12:51:19 +0900
Subject: [PATCH] implement memv and assv with C

---
 include/picrin/pair.h |  3 +++
 piclib/prelude.scm    | 17 +------------
 src/pair.c            | 55 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 59 insertions(+), 16 deletions(-)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index f8c921e7..c7319e25 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -50,9 +50,12 @@ pic_value pic_reverse(pic_state *, pic_value);
 pic_value pic_append(pic_state *, pic_value, pic_value);
 
 pic_value pic_memq(pic_state *, pic_value key, pic_value list);
+pic_value pic_memv(pic_state *, pic_value key, pic_value list);
 
 pic_value pic_assq(pic_state *, pic_value key, pic_value assoc);
+pic_value pic_assv(pic_state *, pic_value key, pic_value assoc);
 pic_value pic_assoc(pic_state *, pic_value key, pic_value assoc);
+
 pic_value pic_acons(pic_state *, pic_value key, pic_value val, pic_value assoc);
 
 pic_value pic_caar(pic_state *, pic_value);
diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index 482818af..2db0ed58 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -823,20 +823,6 @@
 
 ;;; 6.4 Pairs and lists
 
-(define (memv obj list)
-  (if (null? list)
-      #f
-      (if (eqv? obj (car list))
-	  list
-	  (memq obj (cdr list)))))
-
-(define (assv obj list)
-  (if (null? list)
-      #f
-      (if (eqv? obj (caar list))
-	  (car list)
-	  (assq obj (cdr list)))))
-
 (define (member obj list . opts)
   (let ((compare (if (null? opts) equal? (car opts))))
     (if (null? list)
@@ -853,8 +839,7 @@
 	    (car list)
 	    (assoc obj (cdr list) compare)))))
 
-(export memv member
-        assv assoc)
+(export member assoc)
 
 ;;; 6.5. Symbols
 
diff --git a/src/pair.c b/src/pair.c
index 068fab47..2c80f363 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -276,6 +276,21 @@ pic_memq(pic_state *pic, pic_value key, pic_value list)
   goto enter;
 }
 
+pic_value
+pic_memv(pic_state *pic, pic_value key, pic_value list)
+{
+ enter:
+
+  if (pic_nil_p(list))
+    return pic_false_value();
+
+  if (pic_eqv_p(key, pic_car(pic, list)))
+    return list;
+
+  list = pic_cdr(pic, list);
+  goto enter;
+}
+
 pic_value
 pic_assq(pic_state *pic, pic_value key, pic_value assoc)
 {
@@ -294,6 +309,24 @@ pic_assq(pic_state *pic, pic_value key, pic_value assoc)
   goto enter;
 }
 
+pic_value
+pic_assv(pic_state *pic, pic_value key, pic_value assoc)
+{
+  pic_value cell;
+
+ enter:
+
+  if (pic_nil_p(assoc))
+    return pic_false_value();
+
+  cell = pic_car(pic, assoc);
+  if (pic_eqv_p(key, pic_car(pic, cell)))
+    return cell;
+
+  assoc = pic_cdr(pic, assoc);
+  goto enter;
+}
+
 pic_value
 pic_assoc(pic_state *pic, pic_value key, pic_value assoc)
 {
@@ -619,6 +652,16 @@ pic_pair_memq(pic_state *pic)
   return pic_memq(pic, key, list);
 }
 
+static pic_value
+pic_pair_memv(pic_state *pic)
+{
+  pic_value key, list;
+
+  pic_get_args(pic, "oo", &key, &list);
+
+  return pic_memv(pic, key, list);
+}
+
 static pic_value
 pic_pair_assq(pic_state *pic)
 {
@@ -629,6 +672,16 @@ pic_pair_assq(pic_state *pic)
   return pic_assq(pic, key, list);
 }
 
+static pic_value
+pic_pair_assv(pic_state *pic)
+{
+  pic_value key, list;
+
+  pic_get_args(pic, "oo", &key, &list);
+
+  return pic_assv(pic, key, list);
+}
+
 void
 pic_init_pair(pic_state *pic)
 {
@@ -654,5 +707,7 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "list-set!", pic_pair_list_set);
   pic_defun(pic, "list-copy", pic_pair_list_copy);
   pic_defun(pic, "memq", pic_pair_memq);
+  pic_defun(pic, "memv", pic_pair_memv);
   pic_defun(pic, "assq", pic_pair_assq);
+  pic_defun(pic, "assv", pic_pair_assv);
 }