Rewrite MEMBER using SATISFIES-TEST-P
authorOwen Rodley <Strigoides@gmail.com>
Sat, 18 May 2013 04:29:32 +0000 (16:29 +1200)
committerOwen Rodley <Strigoides@gmail.com>
Sat, 18 May 2013 04:29:32 +0000 (16:29 +1200)
src/list.lisp
tests/list.lisp

index 96a3594..a41d821 100644 (file)
   (and (consp (cdr x))
        (cons (car x) (butlast (cdr x)))))
 
-(defun member (x list &key (key #'identity) (test #'eql))
+(defun member (x list &key key (test #'eql testp) (test-not #'eql test-not-p)) 
   (while list
-    (when (funcall test x (funcall key (car list)))
+    (when (satisfies-test-p x (car list) :key key :test test :testp testp
+                            :test-not test-not :test-not-p test-not-p)
       (return list))
     (setq list (cdr list))))
 
index 075a657..c72eec8 100644 (file)
 (test (not   (member 4 '(1 2 3))))
 (test (equal (member 4 '((1 . 2) (3 . 4)) :key #'cdr) '((3 . 4))))
 (test (member '(2) '((1) (2) (3)) :test #'equal))
+(test (member 1 '(1 2 3) :test-not #'eql))
 
 ; ADJOIN
 (test (equal (adjoin 1 '(2 3))   '(1 2 3)))