From a2c00017ea339c7846c131e6bfb65101af584ba9 Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Sat, 19 Jul 2014 12:48:27 +0900
Subject: [PATCH] implement memq and assq with c

---
 include/picrin/pair.h |  2 ++
 piclib/prelude.scm    | 25 ++-----------------------
 src/pair.c            | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 41 insertions(+), 23 deletions(-)

diff --git a/include/picrin/pair.h b/include/picrin/pair.h
index 1f7fccfa..f8c921e7 100644
--- a/include/picrin/pair.h
+++ b/include/picrin/pair.h
@@ -49,6 +49,8 @@ int pic_length(pic_state *, pic_value);
 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_assq(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);
diff --git a/piclib/prelude.scm b/piclib/prelude.scm
index 3b84c974..482818af 100644
--- a/piclib/prelude.scm
+++ b/piclib/prelude.scm
@@ -39,13 +39,6 @@
   (import (scheme base)
           (picrin dictionary))
 
-  (define (memq obj list)
-    (if (null? list)
-        #f
-        (if (eq? obj (car list))
-            list
-            (memq obj (cdr list)))))
-
   (define (list->vector list)
     (define vector (make-vector (length list)))
     (define (go list i)
@@ -830,13 +823,6 @@
 
 ;;; 6.4 Pairs and lists
 
-(define (memq obj list)
-  (if (null? list)
-      #f
-      (if (eq? obj (car list))
-	  list
-	  (memq obj (cdr list)))))
-
 (define (memv obj list)
   (if (null? list)
       #f
@@ -844,13 +830,6 @@
 	  list
 	  (memq obj (cdr list)))))
 
-(define (assq obj list)
-  (if (null? list)
-      #f
-      (if (eq? obj (caar list))
-	  (car list)
-	  (assq obj (cdr list)))))
-
 (define (assv obj list)
   (if (null? list)
       #f
@@ -874,8 +853,8 @@
 	    (car list)
 	    (assoc obj (cdr list) compare)))))
 
-(export memq memv member
-        assq assv assoc)
+(export memv member
+        assv assoc)
 
 ;;; 6.5. Symbols
 
diff --git a/src/pair.c b/src/pair.c
index 499b7bb5..068fab47 100644
--- a/src/pair.c
+++ b/src/pair.c
@@ -261,6 +261,21 @@ pic_append(pic_state *pic, pic_value xs, pic_value ys)
   return ys;
 }
 
+pic_value
+pic_memq(pic_state *pic, pic_value key, pic_value list)
+{
+ enter:
+
+  if (pic_nil_p(list))
+    return pic_false_value();
+
+  if (pic_eq_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)
 {
@@ -594,6 +609,26 @@ pic_pair_list_copy(pic_state *pic)
   return pic_list_copy(pic, obj);
 }
 
+static pic_value
+pic_pair_memq(pic_state *pic)
+{
+  pic_value key, list;
+
+  pic_get_args(pic, "oo", &key, &list);
+
+  return pic_memq(pic, key, list);
+}
+
+static pic_value
+pic_pair_assq(pic_state *pic)
+{
+  pic_value key, list;
+
+  pic_get_args(pic, "oo", &key, &list);
+
+  return pic_assq(pic, key, list);
+}
+
 void
 pic_init_pair(pic_state *pic)
 {
@@ -618,4 +653,6 @@ pic_init_pair(pic_state *pic)
   pic_defun(pic, "list-ref", pic_pair_list_ref);
   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, "assq", pic_pair_assq);
 }