core: Add memq.
authorJan Nieuwenhuizen <janneke@gnu.org>
Thu, 5 Apr 2018 09:03:09 +0000 (11:03 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Thu, 5 Apr 2018 09:03:09 +0000 (11:03 +0200)
* lib/mes.c (memq): New function.
* module/mes/scm.mes (memq): Remove.

module/mes/scm.mes
src/lib.c

index 438568ade9ddaa0229daa898eecd36358d12b95b..805b031838c34f73b611588988eedd4ed5815d2b 100644 (file)
 (define assv-ref assq-ref)
 
 (define (assoc key alist)
-  (if (null? alist) #f ;; IF
+  (if (null? alist) #f
       (if (equal? key (caar alist)) (car alist)
           (assoc key (cdr alist)))))
 
         (let ((entry (set-cdr! entry value)))
           alist))))
 
-(define (memq x lst)
-  (if (null? lst) #f ;; IF
-      (if (eq? x (car lst)) lst
-          (memq x (cdr lst)))))
 (define memv memq)
 
 (define (member x lst)
-  (if (null? lst) #f ;; IF
+  (if (null? lst) #f
       (if (equal? x (car lst)) lst
           (member x (cdr lst)))))
 
index 9149741847bccd51b5cdb496788fa76aa3f58004..f660b8f61d4714df919475b3691724752cc23a40 100644 (file)
--- a/src/lib.c
+++ b/src/lib.c
@@ -243,3 +243,28 @@ xassq (SCM x, SCM a) ///for speed in core only
   while (a != cell_nil && x != CDAR (a)) a = CDR (a);
   return a != cell_nil ? CAR (a) : cell_f;
 }
+
+SCM
+memq (SCM x, SCM a)
+{
+  switch (TYPE (x))
+    {
+    case TCHAR:
+    case TNUMBER:
+      {
+        SCM v = VALUE (x);
+        while (a != cell_nil && v != VALUE (CAR (a))) a = CDR (a); break;
+      }
+    case TKEYWORD:
+      {
+        SCM v = STRING (x);
+        while (a != cell_nil && v != STRING (CAR (a))) a = CDR (a); break;
+      }
+      // case TSYMBOL:
+      // case TSPECIAL:
+    default:
+      while (a != cell_nil && x != CAR (a)) a = CDR (a); break;
+    }
+  return a != cell_nil ? a : cell_f;
+}
+