X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Flist.lisp;h=7a4ca6d909dfd7c9ff98d5fac5b6e2dfeaf4b2db;hb=68cd2db6542fa3442d46b0331ecf8be8f86c09c2;hp=bbb755735e1f26627e94c1bfe372cf3776c9eabc;hpb=7478a2dfeb75791695ea643ecaa56adba8d77139;p=jscl.git

diff --git a/src/list.lisp b/src/list.lisp
index bbb7557..7a4ca6d 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -116,6 +116,12 @@
          (tree-equal (car tree1) (car tree2) :test test)
          (tree-equal (cdr tree1) (cdr tree2) :test test))))
 
+(defun tailp (object list)
+  (do ((tail list (cdr tail)))
+    ((atom tail) (eq object tail))
+    (when (eql tail object)
+      (return-from tailp t))))
+
 (defun subst (new old tree &key (key #'identity) (test #'eql))
   (cond 
     ((funcall test (funcall key tree) (funcall key old))
@@ -164,9 +170,9 @@
   (and (consp (cdr x))
        (cons (car x) (butlast (cdr x)))))
 
-(defun member (x list)
+(defun member (x list &key (key #'identity) (test #'eql))
   (while list
-    (when (eql x (car list))
+    (when (funcall test x (funcall key (car list)))
       (return list))
     (setq list (cdr list))))
 
@@ -174,10 +180,33 @@
 (defun assoc (x alist &key (test #'eql))
   (while alist
     (if (funcall test x (caar alist))
-        (return)
-        (setq alist (cdr alist))))
+      (return)
+      (setq alist (cdr alist))))
   (car alist))
 
+(defun rassoc (x alist &key (test #'eql))
+  (while alist
+    (if (funcall test x (cdar alist))
+      (return)
+      (setq alist (cdr alist))))
+  (car alist))
+
+(defun acons (key datum alist)
+  (cons (cons key datum) alist))
+
+(defun pairlis (keys data &optional (alist ()))
+  (while keys
+    (setq alist (acons (car keys) (car data) alist))
+    (setq keys (cdr keys))
+    (setq data (cdr data)))
+  alist)
+
+(defun copy-alist (alist)
+  (let ((new-alist ()))
+    (while alist
+      (push (cons (caar alist) (cdar alist)) new-alist)
+      (setq alist (cdr alist)))
+    (reverse new-alist)))
 
 
 (define-setf-expander car (x)
@@ -234,3 +263,16 @@
        (3rd y 2nd))               ;3rd follows 2nd down the list.
       ((atom 2nd) 3rd)
     (rplacd 2nd 3rd)))
+
+
+(defun adjoin (item list &key (test #'eql) (key #'identity))
+  (if (member item list :key key :test test)
+    list
+    (cons item list)))
+
+(defun intersection (list1 list2 &key (test #'eql) (key #'identity))
+  (let ((new-list ()))
+    (dolist (x list1)
+      (when (member x list2 :test test :key key)
+        (push x new-list)))
+    new-list))