X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Flist.lisp;h=45aee57fc4cc77979e50c8f55e9817887b0a04bd;hb=6b1ca8628e9818fb891fcbef20d090ec244d3593;hp=99e6e7adb84361400b55e91fbefe273646180694;hpb=1037cbf99ccaa55d6d0c799fcefbcffda4f7b486;p=jscl.git

diff --git a/src/list.lisp b/src/list.lisp
index 99e6e7a..45aee57 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -99,6 +99,19 @@
 (defun cdddar (x) (cdr (cddar x)))
 (defun cddddr (x) (cdr (cdddr x)))
 
+(defun sublis (alist tree &key key (test #'eql testp) (test-not #'eql test-not-p))
+  (labels ((s (tree)
+             (when (and testp test-not-p)
+               (error "Both test and test-not are set"))
+             (let* ((key-val (if key (funcall key tree) tree))
+                    (replace (if test-not-p
+                                 (assoc key-val alist :test-not test-not)
+                                 (assoc key-val alist :test test)))
+                    (x (if replace (cdr replace) tree)))
+               (if (atom x)
+                   x
+                   (cons (s (car x)) (s (cdr x)))))))
+    (s tree)))
 
 (defun copy-list (x)
   (mapcar #'identity x))