From: Alfredo Beaumont Date: Wed, 15 May 2013 12:56:54 +0000 (+0200) Subject: Modify SUBST to: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7b9c47361e1aac31bc78d4627b651b8cc5ee0a7c;p=jscl.git Modify SUBST to: * use satisfies-test-p to check if tree items satisfy the test * return the same (sub)tree if no substitution has been done. Implementation dependent test is changed accordingly. --- diff --git a/src/list.lisp b/src/list.lisp index f7e15ec..d0ec517 100644 --- a/src/list.lisp +++ b/src/list.lisp @@ -114,14 +114,17 @@ (s tree))) (defun subst (new old tree &key key (test #'eql testp) (test-not #'eql test-not-p)) - (when (and testp test-not-p) - (error "Both test and test-not are set")) (labels ((s (x) - (let ((key-val (if key (funcall key x) x))) - (cond - ((funcall (if test-not-p test-not test) key-val old) new) - ((atom x) x) - (t (cons (s (car x)) (s (cdr x)))))))) + (cond ((satisfies-test-p old x :key key :test test :testp testp + :test-not test-not :test-not-p test-not-p) + new) + ((atom x) x) + (t (let ((a (s (car x))) + (b (s (cdr x)))) + (if (and (eq a (car x)) + (eq b (cdr x))) + x + (cons a b))))))) (s tree))) (defun copy-list (x) diff --git a/tests/list.lisp b/tests/list.lisp index 77b93c6..7ce643e 100644 --- a/tests/list.lisp +++ b/tests/list.lisp @@ -97,7 +97,7 @@ (let ((tree1 '(1 (1 2) (1 2 3) (1 2 3 4)))) (test (equal (subst "two" 2 tree1) '(1 (1 "two") (1 "two" 3) (1 "two" 3 4)))) (test (equal (subst "five" 5 tree1) '(1 (1 2) (1 2 3) (1 2 3 4)))) - (test (not (eq tree1 (subst "five" 5 tree1)))) ; Implementation dependent + (test (eq tree1 (subst "five" 5 tree1))) ; Implementation dependent (test (equal tree1 '(1 (1 2) (1 2 3) (1 2 3 4))))) (test (equal (subst 'tempest 'hurricane '(shakespeare wrote (the hurricane)))