Merge branch 'memq-in-c'

Conflicts:
	piclib/prelude.scm

include/picrin/pair.h

@@ -49,8 +49,13 @@ 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_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);

piclib/picrin/macro.scm

@@ -6,13 +6,6 @@
 
   ;; assumes no derived expressions are provided yet
 
-  (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)

piclib/prelude.scm

@@ -630,34 +630,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
-      (if (eqv? obj (car list))
-	  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
-      (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)
@@ -674,8 +646,7 @@
 	    (car list)
 	    (assoc obj (cdr list) compare)))))
 
-(export memq memv member
+(export member assoc)
-        assq assv assoc)
 
 ;;; 6.5. Symbols
 

src/pair.c

@@ -261,6 +261,36 @@ 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_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)
 {
@@ -279,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)
 {
@@ -594,6 +642,46 @@ 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_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)
+{
+  pic_value key, list;
+
+  pic_get_args(pic, "oo", &key, &list);
+
+  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)
 {
@@ -618,4 +706,8 @@ 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, "memv", pic_pair_memv);
+  pic_defun(pic, "assq", pic_pair_assq);
+  pic_defun(pic, "assv", pic_pair_assv);
 }