From: Strigoides <Strigoides@gmail.com>
Date: Fri, 26 Apr 2013 19:58:10 +0000 (+1200)
Subject: Add SUBST function
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=47634cb14b5946d1b49b31fdd2f51e3b65cc7b15;p=jscl.git

Add SUBST function
---

diff --git a/src/list.lisp b/src/list.lisp
index 37ab763..fd6b5d3 100644
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -45,3 +45,11 @@
     (cons (copy-tree (car tree))
           (copy-tree (cdr tree)))
     tree))
+
+(defun subst (new old tree &key (key #'identity) (test #'eql))
+  (if (funcall test (funcall key tree) (funcall key old))
+    new
+    (if (consp tree)
+      (cons (subst new old (car tree) :key key :test test)
+            (subst new old (cdr tree) :key key :test test))
+      tree)))
diff --git a/src/toplevel.lisp b/src/toplevel.lisp
index 3fb6491..0c418f7 100644
--- a/src/toplevel.lisp
+++ b/src/toplevel.lisp
@@ -71,7 +71,7 @@
           prin1-to-string print proclaim prog1 prog2 progn psetq push
           quote read-from-string remove remove-if remove-if-not return
           return-from revappend reverse rplaca rplacd second set setf
-          setq some string string-upcase string= stringp subseq
+          setq some string string-upcase string= stringp subseq subst
           symbol-function symbol-name symbol-package symbol-plist
           symbol-value symbolp t tagbody third throw truncate unless
           unwind-protect values values-list variable warn when write-line
diff --git a/tests/list.lisp b/tests/list.lisp
index ae986d8..aba417a 100644
--- a/tests/list.lisp
+++ b/tests/list.lisp
@@ -1,5 +1,6 @@
 ; Tests for list functions
 
+; COPY-TREE
 (test (let* ((foo '((1 2) (3 4)))
              (bar (copy-tree foo)))
         ;; (SETF (CAR (CAR FOO)) 0) doesn't work in the test for some reason,
@@ -9,3 +10,6 @@
         ;; Once it does the lists can be compared directly
         (not (= (car (car foo))
                 (car (car bar))))))
+
+; SUBST
+; Can't really test this until EQUAL works properly on lists