61 |
(count nil)) |
(count nil)) |
62 |
(assert (not (and test-p test-not-p))) |
(assert (not (and test-p test-not-p))) |
63 |
(my-remove-if |
(my-remove-if |
64 |
(cond (test-p #'(lambda (x) (funcall test element x))) |
(cond (test-p |
65 |
(test-not-p #'(lambda (x) (not (funcall test-not element x)))) |
(setf test (coerce test 'function)) |
66 |
|
#'(lambda (x) (funcall (the function test) element x))) |
67 |
|
(test-not-p |
68 |
|
(setf test-not (coerce test-not 'function)) |
69 |
|
#'(lambda (x) (not (funcall (the function test-not) element x)))) |
70 |
(t #'(lambda (x) (eql element x)))) |
(t #'(lambda (x) (eql element x)))) |
71 |
sequence :start start :end end :key key :from-end from-end :count count)) |
sequence :start start :end end :key key :from-end from-end :count count)) |
72 |
|
|
89 |
(assert (integerp count)) |
(assert (integerp count)) |
90 |
(assert (or (symbolp predicate) (functionp predicate))) |
(assert (or (symbolp predicate) (functionp predicate))) |
91 |
(assert (or (symbolp key) (functionp key))) |
(assert (or (symbolp key) (functionp key))) |
92 |
|
|
93 |
|
(setf predicate (coerce predicate 'function)) |
94 |
|
(setf key (coerce key 'function)) |
95 |
|
|
96 |
;; If FROM-END, reverse the sequence and flip |
;; If FROM-END, reverse the sequence and flip |
97 |
;; start, end |
;; start, end |
108 |
(if (and (> count 0) |
(if (and (> count 0) |
109 |
(>= pos start) |
(>= pos start) |
110 |
(< pos end) |
(< pos end) |
111 |
(funcall predicate (funcall key e))) |
(funcall (the function predicate) |
112 |
|
(funcall (the function key) e))) |
113 |
(decf count) |
(decf count) |
114 |
(push e result)) |
(push e result)) |
115 |
(incf pos)) |
(incf pos)) |
208 |
(defun random-test-remove (maxlen &key (tested-fn #'remove) |
(defun random-test-remove (maxlen &key (tested-fn #'remove) |
209 |
(check-fn #'my-remove) |
(check-fn #'my-remove) |
210 |
(pure t)) |
(pure t)) |
211 |
|
(setf tested-fn (coerce tested-fn 'function)) |
212 |
|
(setf check-fn (coerce check-fn 'function)) |
213 |
(multiple-value-bind (element seq arg-list) |
(multiple-value-bind (element seq arg-list) |
214 |
(random-test-remove-args maxlen) |
(random-test-remove-args maxlen) |
215 |
(let* ((seq1 (copy-seq seq)) |
(let* ((seq1 (copy-seq seq)) |
216 |
(seq2 (copy-seq seq)) |
(seq2 (copy-seq seq)) |
217 |
(seq1r (apply tested-fn element seq1 arg-list)) |
(seq1r (apply (the function tested-fn) element seq1 arg-list)) |
218 |
(seq2r (apply check-fn element seq2 arg-list))) |
(seq2r (apply (the function check-fn) element seq2 arg-list))) |
219 |
(setq *remove-fail-args* (list* element seq1 arg-list)) |
(setq *remove-fail-args* (list* element seq1 arg-list)) |
220 |
(cond |
(cond |
221 |
((and pure (not (equalp seq seq1))) :fail1) |
((and pure (not (equalp seq seq1))) :fail1) |
232 |
(remf arg-list :test) |
(remf arg-list :test) |
233 |
(remf arg-list :test-not) |
(remf arg-list :test-not) |
234 |
(unless test (setq test #'eql)) |
(unless test (setq test #'eql)) |
235 |
|
(setf test (coerce test 'function)) |
236 |
(if fn |
(if fn |
237 |
(case (random 3) |
(case (random 3) |
238 |
(0 (setf arg-list (list* :key 'identity arg-list))) |
(0 (setf arg-list (list* :key 'identity arg-list))) |
239 |
(1 (setf arg-list (list* :key #'identity arg-list))) |
(1 (setf arg-list (list* :key #'identity arg-list))) |
240 |
(t nil)) |
(t nil)) |
241 |
(setf fn (if (coin) 'identity |
(setf fn (if (coin) 'identity |
242 |
#'(lambda (x) (funcall test element x))))) |
#'(lambda (x) (funcall (the function test) |
243 |
|
element x))))) |
244 |
(let* ((seq1 (copy-seq seq)) |
(let* ((seq1 (copy-seq seq)) |
245 |
(seq2 (copy-seq seq)) |
(seq2 (copy-seq seq)) |
246 |
(seq1r (apply (if negate #'remove-if-not #'remove-if) |
(seq1r (apply (if negate #'remove-if-not #'remove-if) |
266 |
(remf arg-list :test) |
(remf arg-list :test) |
267 |
(remf arg-list :test-not) |
(remf arg-list :test-not) |
268 |
(unless test (setq test #'eql)) |
(unless test (setq test #'eql)) |
269 |
|
(setf test (coerce test 'function)) |
270 |
(if fn |
(if fn |
271 |
(case (random 3) |
(case (random 3) |
272 |
(0 (setf arg-list (list* :key 'identity arg-list))) |
(0 (setf arg-list (list* :key 'identity arg-list))) |
273 |
(1 (setf arg-list (list* :key #'identity arg-list))) |
(1 (setf arg-list (list* :key #'identity arg-list))) |
274 |
(t nil)) |
(t nil)) |
275 |
(setf fn (if (coin) 'identity |
(setf fn (if (coin) 'identity |
276 |
#'(lambda (x) (funcall test element x))))) |
#'(lambda (x) (funcall (the function test) element x))))) |
277 |
(setq *remove-fail-args* (list* seq arg-list)) |
(setq *remove-fail-args* (list* seq arg-list)) |
278 |
(let* ((seq1 (copy-seq seq)) |
(let* ((seq1 (copy-seq seq)) |
279 |
(seq2 (copy-seq seq)) |
(seq2 (copy-seq seq)) |