17 |
(cond |
(cond |
18 |
((consp x) |
((consp x) |
19 |
(and (consp y) |
(and (consp y) |
20 |
(not (eq x y)) |
(not (eqt x y)) |
21 |
(check-cons-copy (car x) (car y)) |
(check-cons-copy (car x) (car y)) |
22 |
(check-cons-copy (cdr x) (cdr y)))) |
(check-cons-copy (cdr x) (cdr y)))) |
23 |
((eq x y) t) |
((eqt x y) t) |
24 |
(t nil))) |
(t nil))) |
25 |
|
|
26 |
;; Try copy-tree on a tree containing elements of various kinds |
;; Try copy-tree on a tree containing elements of various kinds |
55 |
(apply #'sublis al a |
(apply #'sublis al a |
56 |
`(,@(when test `(:test ,test)) |
`(,@(when test `(:test ,test)) |
57 |
,@(when test-not `(:test-not ,test-not)) |
,@(when test-not `(:test-not ,test-not)) |
58 |
,@(unless (eq key 'no-key) `(:key ,key)))))) |
,@(unless (eqt key 'no-key) `(:key ,key)))))) |
59 |
(and |
(and |
60 |
(check-scaffold-copy a acopy) |
(check-scaffold-copy a acopy) |
61 |
(check-scaffold-copy al alcopy) |
(check-scaffold-copy al alcopy) |
131 |
(apply #'sublis (copy-tree al) (copy-tree a) |
(apply #'sublis (copy-tree al) (copy-tree a) |
132 |
`(,@(when test `(:test ,test)) |
`(,@(when test `(:test ,test)) |
133 |
,@(when test-not `(:test-not ,test-not)) |
,@(when test-not `(:test-not ,test-not)) |
134 |
,@(unless (eq key 'no-key) `(:key ,key)))))) |
,@(unless (eqt key 'no-key) `(:key ,key)))))) |
135 |
as)) |
as)) |
136 |
|
|
137 |
|
|
215 |
(treecopy (make-scaffold-copy tree))) |
(treecopy (make-scaffold-copy tree))) |
216 |
(let ((result |
(let ((result |
217 |
(apply #'subst new old tree |
(apply #'subst new old tree |
218 |
`(,@(unless (eq key 'no-key) `(:key ,key)) |
`(,@(unless (eqt key 'no-key) `(:key ,key)) |
219 |
,@(when test `(:test ,test)) |
,@(when test `(:test ,test)) |
220 |
,@(when test-not `(:test-not ,test-not)))))) |
,@(when test-not `(:test-not ,test-not)))))) |
221 |
(and (check-scaffold-copy new newcopy) |
(and (check-scaffold-copy new newcopy) |
296 |
(treecopy (make-scaffold-copy tree))) |
(treecopy (make-scaffold-copy tree))) |
297 |
(let ((result |
(let ((result |
298 |
(apply #'subst-if new pred tree |
(apply #'subst-if new pred tree |
299 |
(unless (eq key 'no-key) `(:key ,key))))) |
(unless (eqt key 'no-key) `(:key ,key))))) |
300 |
(and (check-scaffold-copy new newcopy) |
(and (check-scaffold-copy new newcopy) |
301 |
(check-scaffold-copy pred predcopy) |
(check-scaffold-copy pred predcopy) |
302 |
(check-scaffold-copy tree treecopy) |
(check-scaffold-copy tree treecopy) |
312 |
(treecopy (make-scaffold-copy tree))) |
(treecopy (make-scaffold-copy tree))) |
313 |
(let ((result |
(let ((result |
314 |
(apply #'subst-if-not new pred tree |
(apply #'subst-if-not new pred tree |
315 |
(unless (eq key 'no-key) `(:key ,key))))) |
(unless (eqt key 'no-key) `(:key ,key))))) |
316 |
(and (check-scaffold-copy new newcopy) |
(and (check-scaffold-copy new newcopy) |
317 |
(check-scaffold-copy pred predcopy) |
(check-scaffold-copy pred predcopy) |
318 |
(check-scaffold-copy tree treecopy) |
(check-scaffold-copy tree treecopy) |
403 |
(setf old (copy-tree old)) |
(setf old (copy-tree old)) |
404 |
(setf tree (copy-tree tree)) |
(setf tree (copy-tree tree)) |
405 |
(apply #'nsubst new old tree |
(apply #'nsubst new old tree |
406 |
`(,@(unless (eq key 'no-key) `(:key ,key)) |
`(,@(unless (eqt key 'no-key) `(:key ,key)) |
407 |
,@(when test `(:test ,test)) |
,@(when test `(:test ,test)) |
408 |
,@(when test-not `(:test-not ,test-not))))) |
,@(when test-not `(:test-not ,test-not))))) |
409 |
|
|
474 |
(setf new (copy-tree new)) |
(setf new (copy-tree new)) |
475 |
(setf tree (copy-tree tree)) |
(setf tree (copy-tree tree)) |
476 |
(apply #'nsubst-if new pred tree |
(apply #'nsubst-if new pred tree |
477 |
(unless (eq key 'no-key) `(:key ,key)))) |
(unless (eqt key 'no-key) `(:key ,key)))) |
478 |
|
|
479 |
(defun check-nsubst-if-not (new pred tree &key (key 'no-key)) |
(defun check-nsubst-if-not (new pred tree &key (key 'no-key)) |
480 |
"Call nsubst-if-not new pred tree, with keyword arguments if present." |
"Call nsubst-if-not new pred tree, with keyword arguments if present." |
481 |
(setf new (copy-tree new)) |
(setf new (copy-tree new)) |
482 |
(setf tree (copy-tree tree)) |
(setf tree (copy-tree tree)) |
483 |
(apply #'nsubst-if-not new pred tree |
(apply #'nsubst-if-not new pred tree |
484 |
(unless (eq key 'no-key) `(:key ,key)))) |
(unless (eqt key 'no-key) `(:key ,key)))) |
485 |
|
|
486 |
(deftest nsubst-if-1 |
(deftest nsubst-if-1 |
487 |
(check-nsubst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c))) |
(check-nsubst-if 'a #'consp '((100 1) (2 3) (4 3 2 1) (a b c))) |