1 ;;;; Extensible sequences, based on the proposal by Christophe Rhodes.
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is in the public domain and is provided with
7 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
10 (in-package "SB-IMPL")
13 (define-condition sequence::protocol-unimplemented (type-error)
16 (defun sequence::protocol-unimplemented (sequence)
17 (error 'sequence::protocol-unimplemented
18 :datum sequence :expected-type '(or list vector)))
20 (defgeneric sequence:length (sequence)
21 (:method ((s list)) (length s))
22 (:method ((s vector)) (length s))
23 (:method ((s sequence)) (sequence::protocol-unimplemented s)))
25 (defgeneric sequence:elt (sequence index)
26 (:method ((s list) index) (elt s index))
27 (:method ((s vector) index) (elt s index))
28 (:method ((s sequence) index) (sequence::protocol-unimplemented s)))
30 (defgeneric (setf sequence:elt) (new-value sequence index)
31 (:argument-precedence-order sequence new-value index)
32 (:method (new-value (s list) index) (setf (elt s index) new-value))
33 (:method (new-value (s vector) index) (setf (elt s index) new-value))
34 (:method (new-value (s sequence) index)
35 (sequence::protocol-unimplemented s)))
37 (defgeneric sequence:make-sequence-like
38 (sequence length &key initial-element initial-contents)
39 (:method ((s list) length &key
40 (initial-element nil iep) (initial-contents nil icp))
42 ((and icp iep) (error "bar"))
43 (iep (make-list length :initial-element initial-element))
44 (icp (unless (= (length initial-contents) length)
46 (let ((result (make-list length)))
47 (replace result initial-contents)
49 (t (make-list length))))
50 (:method ((s vector) length &key
51 (initial-element nil iep) (initial-contents nil icp))
53 ((and icp iep) (error "foo"))
54 (iep (make-array length :element-type (array-element-type s)
55 :initial-element initial-element))
56 (icp (make-array length :element-type (array-element-type s)
57 :initial-contents initial-contents))
58 (t (make-array length :element-type (array-element-type s)))))
59 (:method ((s sequence) length &key initial-element initial-contents)
60 (declare (ignore initial-element initial-contents))
61 (sequence::protocol-unimplemented s)))
63 (defgeneric sequence:adjust-sequence
64 (sequence length &key initial-element initial-contents)
65 (:method ((s list) length &key initial-element (initial-contents nil icp))
68 (let ((olength (length s)))
70 ((eql length olength) (if icp (replace s initial-contents) s))
72 (rplacd (nthcdr (1- length) s) nil)
73 (if icp (replace s initial-contents) s))
75 (let ((return (make-list length :initial-element initial-element)))
76 (if icp (replace return initial-contents) return)))
77 (t (rplacd (nthcdr (1- olength) s)
78 (make-list (- length olength)
79 :initial-element initial-element))
80 (if icp (replace s initial-contents) s))))))
81 (:method ((s vector) length &rest args &key (initial-contents nil icp) initial-element)
82 (declare (ignore initial-element))
84 ((and (array-has-fill-pointer-p s)
85 (>= (array-total-size s) length))
86 (setf (fill-pointer s) length)
87 (if icp (replace s initial-contents) s))
88 ((eql (length s) length)
89 (if icp (replace s initial-contents) s))
90 (t (apply #'adjust-array s length args))))
91 (:method (new-value (s sequence) &rest args)
92 (declare (ignore args))
93 (sequence::protocol-unimplemented s)))
95 ;;;; iterator protocol
97 ;;; The general protocol
99 (defgeneric sequence:make-sequence-iterator (sequence &key from-end start end)
100 (:method ((s sequence) &key from-end (start 0) end)
101 (multiple-value-bind (iterator limit from-end)
102 (sequence:make-simple-sequence-iterator
103 s :from-end from-end :start start :end end)
104 (values iterator limit from-end
105 #'sequence:iterator-step #'sequence:iterator-endp
106 #'sequence:iterator-element #'(setf sequence:iterator-element)
107 #'sequence:iterator-index #'sequence:iterator-copy)))
108 (:method ((s t) &key from-end start end)
109 (declare (ignore from-end start end))
112 :expected-type 'sequence)))
114 ;;; the simple protocol: the simple iterator returns three values,
115 ;;; STATE, LIMIT and FROM-END.
117 ;;; magic termination value for list :from-end t
118 (defvar *exhausted* (cons nil nil))
120 (defgeneric sequence:make-simple-sequence-iterator
121 (sequence &key from-end start end)
122 (:method ((s list) &key from-end (start 0) end)
124 (let* ((termination (if (= start 0) *exhausted* (nthcdr (1- start) s)))
125 (init (if (<= (or end (length s)) start)
127 (if end (last s (- (length s) (1- end))) (last s)))))
128 (values init termination t))
130 ((not end) (values (nthcdr start s) nil nil))
131 (t (let ((st (nthcdr start s)))
132 (values st (nthcdr (- end start) st) nil))))))
133 (:method ((s vector) &key from-end (start 0) end)
134 (let ((end (or end (length s))))
136 (values (1- end) (1- start) t)
137 (values start end nil))))
138 (:method ((s sequence) &key from-end (start 0) end)
139 (let ((end (or end (length s))))
141 (values (1- end) (1- start) from-end)
142 (values start end nil)))))
144 (defgeneric sequence:iterator-step (sequence iterator from-end)
145 (:method ((s list) iterator from-end)
149 (do* ((xs s (cdr xs)))
150 ((eq (cdr xs) iterator) xs)))
152 (:method ((s vector) iterator from-end)
156 (:method ((s sequence) iterator from-end)
161 (defgeneric sequence:iterator-endp (sequence iterator limit from-end)
162 (:method ((s list) iterator limit from-end)
164 (:method ((s vector) iterator limit from-end)
166 (:method ((s sequence) iterator limit from-end)
169 (defgeneric sequence:iterator-element (sequence iterator)
170 (:method ((s list) iterator)
172 (:method ((s vector) iterator)
174 (:method ((s sequence) iterator)
177 (defgeneric (setf sequence:iterator-element) (new-value sequence iterator)
178 (:method (o (s list) iterator)
179 (setf (car iterator) o))
180 (:method (o (s vector) iterator)
181 (setf (aref s iterator) o))
182 (:method (o (s sequence) iterator)
183 (setf (elt s iterator) o)))
185 (defgeneric sequence:iterator-index (sequence iterator)
186 (:method ((s list) iterator)
187 ;; FIXME: this sucks. (In my defence, it is the equivalent of the
188 ;; Apple implementation in Dylan...)
189 (loop for l on s for i from 0 when (eq l iterator) return i))
190 (:method ((s vector) iterator) iterator)
191 (:method ((s sequence) iterator) iterator))
193 (defgeneric sequence:iterator-copy (sequence iterator)
194 (:method ((s list) iterator) iterator)
195 (:method ((s vector) iterator) iterator)
196 (:method ((s sequence) iterator) iterator))
198 (defmacro sequence:with-sequence-iterator
199 ((&rest vars) (s &rest args &key from-end start end) &body body)
200 (declare (ignore from-end start end))
202 (vars (mapcar (lambda (x)
203 (or x (let ((name (gensym)))
207 `(multiple-value-bind (,@vars) (sequence:make-sequence-iterator ,s ,@args)
208 (declare (type function ,@(nthcdr 3 vars))
212 (defmacro sequence:with-sequence-iterator-functions
213 ((step endp elt setf index copy)
214 (s &rest args &key from-end start end)
216 (declare (ignore from-end start end))
217 (let ((nstate (gensym "STATE")) (nlimit (gensym "LIMIT"))
218 (nfrom-end (gensym "FROM-END-")) (nstep (gensym "STEP"))
219 (nendp (gensym "ENDP")) (nelt (gensym "ELT"))
220 (nsetf (gensym "SETF")) (nindex (gensym "INDEX"))
221 (ncopy (gensym "COPY")))
222 `(sequence:with-sequence-iterator
223 (,nstate ,nlimit ,nfrom-end ,nstep ,nendp ,nelt ,nsetf ,nindex ,ncopy)
225 (flet ((,step () (setq ,nstate (funcall ,nstep ,s ,nstate ,nfrom-end)))
226 (,endp () (funcall ,nendp ,s ,nstate ,nlimit ,nfrom-end))
227 (,elt () (funcall ,nelt ,s ,nstate))
228 (,setf (new-value) (funcall ,nsetf new-value ,s ,nstate))
229 (,index () (funcall ,nindex ,s ,nstate))
230 (,copy () (funcall ,ncopy ,s ,nstate)))
231 (declare (truly-dynamic-extent #',step #',endp #',elt
232 #',setf #',index #',copy))
235 (defun sequence:canonize-test (test test-not)
237 (test (if (functionp test) test (fdefinition test)))
238 (test-not (if (functionp test-not)
239 (complement test-not)
240 (complement (fdefinition test-not))))
243 (defun sequence:canonize-key (key)
244 (or (and key (if (functionp key) key (fdefinition key))) #'identity))
246 ;;;; LOOP support. (DOSEQUENCE support is present in the core SBCL
248 (defun loop-elements-iteration-path (variable data-type prep-phrases)
250 (loop for (prep . rest) in prep-phrases do
252 ((:of :in) (if of-phrase
253 (sb-loop::loop-error "Too many prepositions")
254 (setq of-phrase rest)))))
255 (destructuring-bind (it lim f-e step endp elt seq)
256 (loop repeat 7 collect (gensym))
257 (push `(let ((,seq ,(car of-phrase)))) sb-loop::*loop-wrappers*)
258 (push `(sequence:with-sequence-iterator (,it ,lim ,f-e ,step ,endp ,elt) (,seq))
259 sb-loop::*loop-wrappers*)
260 `(((,variable nil ,data-type)) () () nil (funcall ,endp ,seq ,it ,lim ,f-e)
261 (,variable (funcall ,elt ,seq ,it) ,it (funcall ,step ,seq ,it ,f-e))))))
262 (sb-loop::add-loop-path
263 '(element elements) 'loop-elements-iteration-path sb-loop::*loop-ansi-universe*
264 :preposition-groups '((:of :in)) :inclusive-permitted nil)
266 ;;;; generic implementations for sequence functions.
268 ;;; FIXME: COUNT, POSITION and FIND share an awful lot of structure.
269 ;;; They could usefully be defined in an OAOO way.
270 (defgeneric sequence:count
271 (item sequence &key from-end start end test test-not key)
272 (:argument-precedence-order sequence item))
273 (defmethod sequence:count
274 (item (sequence sequence) &key from-end (start 0) end test test-not key)
275 (let ((test (sequence:canonize-test test test-not))
276 (key (sequence:canonize-key key)))
277 (sequence:with-sequence-iterator (state limit from-end step endp elt)
278 (sequence :from-end from-end :start start :end end)
280 ((funcall endp sequence state limit from-end) count)
281 (let ((o (funcall elt sequence state)))
282 (when (funcall test item (funcall key o))
284 (setq state (funcall step sequence state from-end)))))))
286 (defgeneric sequence:count-if (pred sequence &key from-end start end key)
287 (:argument-precedence-order sequence pred))
288 (defmethod sequence:count-if
289 (pred (sequence sequence) &key from-end (start 0) end key)
290 (let ((key (sequence:canonize-key key)))
291 (sequence:with-sequence-iterator (state limit from-end step endp elt)
292 (sequence :from-end from-end :start start :end end)
294 ((funcall endp sequence state limit from-end) count)
295 (let ((o (funcall elt sequence state)))
296 (when (funcall pred (funcall key o))
298 (setq state (funcall step sequence state from-end)))))))
300 (defgeneric sequence:count-if-not (pred sequence &key from-end start end key)
301 (:argument-precedence-order sequence pred))
302 (defmethod sequence:count-if-not
303 (pred (sequence sequence) &key from-end (start 0) end key)
304 (let ((key (sequence:canonize-key key)))
305 (sequence:with-sequence-iterator (state limit from-end step endp elt)
306 (sequence :from-end from-end :start start :end end)
308 ((funcall endp sequence state limit from-end) count)
309 (let ((o (funcall elt sequence state)))
310 (unless (funcall pred (funcall key o))
312 (setq state (funcall step sequence state from-end)))))))
314 (defgeneric sequence:find
315 (item sequence &key from-end start end test test-not key)
316 (:argument-precedence-order sequence item))
317 (defmethod sequence:find
318 (item (sequence sequence) &key from-end (start 0) end test test-not key)
319 (let ((test (sequence:canonize-test test test-not))
320 (key (sequence:canonize-key key)))
321 (sequence:with-sequence-iterator (state limit from-end step endp elt)
322 (sequence :from-end from-end :start start :end end)
324 ((funcall endp sequence state limit from-end) nil)
325 (let ((o (funcall elt sequence state)))
326 (when (funcall test item (funcall key o))
328 (setq state (funcall step sequence state from-end)))))))
330 (defgeneric sequence:find-if (pred sequence &key from-end start end key)
331 (:argument-precedence-order sequence pred))
332 (defmethod sequence:find-if
333 (pred (sequence sequence) &key from-end (start 0) end key)
334 (let ((key (sequence:canonize-key key)))
335 (sequence:with-sequence-iterator (state limit from-end step endp elt)
336 (sequence :from-end from-end :start start :end end)
338 ((funcall endp sequence state limit from-end) nil)
339 (let ((o (funcall elt sequence state)))
340 (when (funcall pred (funcall key o))
342 (setq state (funcall step sequence state from-end)))))))
344 (defgeneric sequence:find-if-not (pred sequence &key from-end start end key)
345 (:argument-precedence-order sequence pred))
346 (defmethod sequence:find-if-not
347 (pred (sequence sequence) &key from-end (start 0) end key)
348 (let ((key (sequence:canonize-key key)))
349 (sequence:with-sequence-iterator (state limit from-end step endp elt)
350 (sequence :from-end from-end :start start :end end)
352 ((funcall endp sequence state limit from-end) nil)
353 (let ((o (funcall elt sequence state)))
354 (unless (funcall pred (funcall key o))
356 (setq state (funcall step sequence state from-end)))))))
358 (defgeneric sequence:position
359 (item sequence &key from-end start end test test-not key)
360 (:argument-precedence-order sequence item))
361 (defmethod sequence:position
362 (item (sequence sequence) &key from-end (start 0) end test test-not key)
363 (let ((test (sequence:canonize-test test test-not))
364 (key (sequence:canonize-key key)))
365 (sequence:with-sequence-iterator (state limit from-end step endp elt)
366 (sequence :from-end from-end :start start :end end)
367 (do ((s (if from-end -1 1))
368 (pos (if from-end (1- (or end (length sequence))) start) (+ pos s)))
369 ((funcall endp sequence state limit from-end) nil)
370 (let ((o (funcall elt sequence state)))
371 (when (funcall test item (funcall key o))
373 (setq state (funcall step sequence state from-end)))))))
375 (defgeneric sequence:position-if (pred sequence &key from-end start end key)
376 (:argument-precedence-order sequence pred))
377 (defmethod sequence:position-if
378 (pred (sequence sequence) &key from-end (start 0) end key)
379 (let ((key (sequence:canonize-key key)))
380 (sequence:with-sequence-iterator (state limit from-end step endp elt)
381 (sequence :from-end from-end :start start :end end)
382 (do ((s (if from-end -1 1))
383 (pos (if from-end (1- (or end (length sequence))) start) (+ pos s)))
384 ((funcall endp sequence state limit from-end) nil)
385 (let ((o (funcall elt sequence state)))
386 (when (funcall pred (funcall key o))
388 (setq state (funcall step sequence state from-end)))))))
390 (defgeneric sequence:position-if-not
391 (pred sequence &key from-end start end key)
392 (:argument-precedence-order sequence pred))
393 (defmethod sequence:position-if-not
394 (pred (sequence sequence) &key from-end (start 0) end key)
395 (let ((key (sequence:canonize-key key)))
396 (sequence:with-sequence-iterator (state limit from-end step endp elt)
397 (sequence :from-end from-end :start start :end end)
398 (do ((s (if from-end -1 1))
399 (pos (if from-end (1- (or end (length sequence))) start) (+ pos s)))
400 ((funcall endp sequence state limit from-end) nil)
401 (let ((o (funcall elt sequence state)))
402 (unless (funcall pred (funcall key o))
404 (setq state (funcall step sequence state from-end)))))))
406 (defgeneric sequence:subseq (sequence start &optional end))
407 (defmethod sequence:subseq ((sequence sequence) start &optional end)
408 (let* ((end (or end (length sequence)))
409 (length (- end start))
410 (result (sequence:make-sequence-like sequence length)))
411 (sequence:with-sequence-iterator (state limit from-end step endp elt)
412 (sequence :start start :end end)
413 (declare (ignore limit endp))
414 (sequence:with-sequence-iterator (rstate rlimit rfrom-end rstep rendp relt rsetelt)
416 (declare (ignore rlimit rendp relt))
418 ((>= i length) result)
419 (funcall rsetelt (funcall elt sequence state) result rstate)
420 (setq state (funcall step sequence state from-end))
421 (setq rstate (funcall rstep result rstate rfrom-end)))))))
423 (defgeneric sequence:copy-seq (sequence))
424 (defmethod sequence:copy-seq ((sequence sequence))
425 (sequence:subseq sequence 0))
427 (defgeneric sequence:fill (sequence item &key start end))
428 (defmethod sequence:fill ((sequence sequence) item &key (start 0) end)
429 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
430 (sequence :start start :end end)
431 (declare (ignore elt))
433 ((funcall endp sequence state limit from-end) sequence)
434 (funcall setelt item sequence state)
435 (setq state (funcall step sequence state from-end)))))
437 (defgeneric sequence:nsubstitute
438 (new old sequence &key start end from-end test test-not count key)
439 (:argument-precedence-order sequence new old))
440 (defmethod sequence:nsubstitute (new old (sequence sequence) &key (start 0)
441 end from-end test test-not count key)
442 (let ((test (sequence:canonize-test test test-not))
443 (key (sequence:canonize-key key)))
444 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
445 (sequence :start start :end end :from-end from-end)
447 ((or (and count (>= c count))
448 (funcall endp sequence state limit from-end))
450 (when (funcall test old (funcall key (funcall elt sequence state)))
452 (funcall setelt new sequence state))
453 (setq state (funcall step sequence state from-end))))))
455 (defgeneric sequence:nsubstitute-if
456 (new predicate sequence &key start end from-end count key)
457 (:argument-precedence-order sequence new predicate))
458 (defmethod sequence:nsubstitute-if
459 (new predicate (sequence sequence) &key (start 0) end from-end count key)
460 (let ((key (sequence:canonize-key key)))
461 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
462 (sequence :start start :end end :from-end from-end)
464 ((or (and count (>= c count))
465 (funcall endp sequence state limit from-end))
467 (when (funcall predicate (funcall key (funcall elt sequence state)))
469 (funcall setelt new sequence state))
470 (setq state (funcall step sequence state from-end))))))
472 (defgeneric sequence:nsubstitute-if-not
473 (new predicate sequence &key start end from-end count key)
474 (:argument-precedence-order sequence new predicate))
475 (defmethod sequence:nsubstitute-if-not
476 (new predicate (sequence sequence) &key (start 0) end from-end count key)
477 (let ((key (sequence:canonize-key key)))
478 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
479 (sequence :start start :end end :from-end from-end)
481 ((or (and count (>= c count))
482 (funcall endp sequence state limit from-end))
484 (unless (funcall predicate (funcall key (funcall elt sequence state)))
486 (funcall setelt new sequence state))
487 (setq state (funcall step sequence state from-end))))))
489 (defgeneric sequence:substitute
490 (new old sequence &key start end from-end test test-not count key)
491 (:argument-precedence-order sequence new old))
492 (defmethod sequence:substitute (new old (sequence sequence) &rest args &key
493 (start 0) end from-end test test-not count key)
494 (declare (truly-dynamic-extent args))
495 (declare (ignore start end from-end test test-not count key))
496 (let ((result (copy-seq sequence)))
497 (apply #'sequence:nsubstitute new old result args)))
499 (defgeneric sequence:substitute-if
500 (new predicate sequence &key start end from-end count key)
501 (:argument-precedence-order sequence new predicate))
502 (defmethod sequence:substitute-if (new predicate (sequence sequence) &rest args
503 &key (start 0) end from-end count key)
504 (declare (truly-dynamic-extent args))
505 (declare (ignore start end from-end count key))
506 (let ((result (copy-seq sequence)))
507 (apply #'sequence:nsubstitute-if new predicate result args)))
509 (defgeneric sequence:substitute-if-not
510 (new predicate sequence &key start end from-end count key)
511 (:argument-precedence-order sequence new predicate))
512 (defmethod sequence:substitute-if-not
513 (new predicate (sequence sequence) &rest args &key
514 (start 0) end from-end count key)
515 (declare (truly-dynamic-extent args))
516 (declare (ignore start end from-end count key))
517 (let ((result (copy-seq sequence)))
518 (apply #'sequence:nsubstitute-if-not new predicate result args)))
520 (defun %sequence-replace (sequence1 sequence2 start1 end1 start2 end2)
521 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
522 (sequence1 :start start1 :end end1)
523 (declare (ignore elt1))
524 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
525 (sequence2 :start start2 :end end2)
527 ((or (funcall endp1 sequence1 state1 limit1 from-end1)
528 (funcall endp2 sequence2 state2 limit2 from-end2))
530 (funcall setelt1 (funcall elt2 sequence2 state2) sequence1 state1)
531 (setq state1 (funcall step1 sequence1 state1 from-end1))
532 (setq state2 (funcall step2 sequence2 state2 from-end2))))))
534 (defgeneric sequence:replace
535 (sequence1 sequence2 &key start1 end1 start2 end2)
536 (:argument-precedence-order sequence2 sequence1))
537 (defmethod sequence:replace
538 ((sequence1 sequence) (sequence2 sequence) &key
539 (start1 0) end1 (start2 0) end2)
541 ((eq sequence1 sequence2)
542 (let ((replaces (subseq sequence2 start2 end2)))
543 (%sequence-replace sequence1 replaces start1 end1 0 nil)))
544 (t (%sequence-replace sequence1 sequence2 start1 end1 start2 end2))))
546 (defgeneric sequence:nreverse (sequence))
547 (defmethod sequence:nreverse ((sequence sequence))
548 ;; FIXME: this, in particular the :from-end iterator, will suck
549 ;; mightily if the user defines a list-like structure.
550 (let ((length (length sequence)))
551 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
552 (sequence :end (floor length 2))
553 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2 setelt2)
554 (sequence :start (ceiling length 2) :from-end t)
555 (declare (ignore limit2 endp2))
557 ((funcall endp1 sequence state1 limit1 from-end1) sequence)
558 (let ((x (funcall elt1 sequence state1))
559 (y (funcall elt2 sequence state2)))
560 (funcall setelt1 y sequence state1)
561 (funcall setelt2 x sequence state2))
562 (setq state1 (funcall step1 sequence state1 from-end1))
563 (setq state2 (funcall step2 sequence state2 from-end2)))))))
565 (defgeneric sequence:reverse (sequence))
566 (defmethod sequence:reverse ((sequence sequence))
567 (let ((result (copy-seq sequence)))
568 (sequence:nreverse result)))
570 (defgeneric sequence:reduce
571 (function sequence &key from-end start end initial-value)
572 (:argument-precedence-order sequence function))
573 (defmethod sequence:reduce
574 (function (sequence sequence) &key from-end (start 0) end key
575 (initial-value nil ivp))
576 (let ((key (sequence:canonize-key key)))
577 (sequence:with-sequence-iterator (state limit from-end step endp elt)
578 (sequence :start start :end end :from-end from-end)
579 (if (funcall endp sequence state limit from-end)
580 (if ivp initial-value (funcall function))
581 (do* ((state state (funcall step sequence state from-end))
585 (funcall key (funcall elt sequence state))
586 (setq state (funcall step sequence state from-end)))))))
587 ((funcall endp sequence state limit from-end) value)
588 (let ((e (funcall key (funcall elt sequence state))))
590 (setq value (funcall function e value))
591 (setq value (funcall function value e)))))))))
593 (defgeneric sequence:mismatch (sequence1 sequence2 &key from-end start1 end1
594 start2 end2 test test-not key))
595 (defmethod sequence:mismatch
596 ((sequence1 sequence) (sequence2 sequence) &key from-end (start1 0) end1
597 (start2 0) end2 test test-not key)
598 (let ((test (sequence:canonize-test test test-not))
599 (key (sequence:canonize-key key)))
600 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1)
601 (sequence1 :start start1 :end end1 :from-end from-end)
602 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
603 (sequence2 :start start2 :end end2 :from-end from-end)
605 (do ((result (or end1 (length sequence1)) (1- result))
606 (e1 (funcall endp1 sequence1 state1 limit1 from-end1)
607 (funcall endp1 sequence1 state1 limit1 from-end1))
608 (e2 (funcall endp2 sequence2 state2 limit2 from-end2)
609 (funcall endp2 sequence2 state2 limit2 from-end2)))
610 ((or e1 e2) (if (and e1 e2) nil result))
611 (let ((o1 (funcall key (funcall elt1 sequence1 state1)))
612 (o2 (funcall key (funcall elt2 sequence2 state2))))
613 (unless (funcall test o1 o2)
615 (setq state1 (funcall step1 sequence1 state1 from-end1))
616 (setq state2 (funcall step2 sequence2 state2 from-end2))))
617 (do ((result start1 (1+ result))
618 (e1 (funcall endp1 sequence1 state1 limit1 from-end1)
619 (funcall endp1 sequence1 state1 limit1 from-end1))
620 (e2 (funcall endp2 sequence2 state2 limit2 from-end2)
621 (funcall endp2 sequence2 state2 limit2 from-end2)))
622 ((or e1 e2) (if (and e1 e2) nil result))
623 (let ((o1 (funcall key (funcall elt1 sequence1 state1)))
624 (o2 (funcall key (funcall elt2 sequence2 state2))))
625 (unless (funcall test o1 o2)
627 (setq state1 (funcall step1 sequence1 state1 from-end1))
628 (setq state2 (funcall step2 sequence2 state2 from-end2))))))))
630 (defgeneric sequence:search (sequence1 sequence2 &key from-end start1 end1
631 start2 end2 test test-not key))
632 (defmethod sequence:search
633 ((sequence1 sequence) (sequence2 sequence) &key from-end (start1 0) end1
634 (start2 0) end2 test test-not key)
635 (let* ((test (sequence:canonize-test test test-not))
636 (key (sequence:canonize-key key))
637 (range1 (- (or end1 (length sequence1)) start1))
638 (range2 (- (or end2 (length sequence2)) start2))
639 (count (1+ (- range2 range1))))
641 (return-from sequence:search nil))
642 ;; Create an iteration state for SEQUENCE1 for the interesting
643 ;;range within SEQUENCE1. To compare this range against ranges in
644 ;;SEQUENCE2, we copy START-STATE1 and then mutate the copy.
645 (sequence:with-sequence-iterator (start-state1 nil from-end1 step1 nil elt1)
646 (sequence1 :start start1 :end end1 :from-end from-end)
647 ;; Create an iteration state for the interesting range within
649 (sequence:with-sequence-iterator (start-state2 nil from-end2 step2 nil elt2 nil index2)
650 (sequence2 :start start2 :end end2 :from-end from-end)
651 ;; Copy both iterators at all COUNT possible match positions.
653 (let ((state1 (sequence:iterator-copy sequence1 start-state1))
654 (state2 (sequence:iterator-copy sequence2 start-state2)))
655 ;; Determine whether there is a match at the current
656 ;; position. Return immediately, if there is a match.
659 (return-from sequence:search
660 (let ((position (funcall index2 sequence2 start-state2)))
661 (if from-end (- position range1 -1) position))))
662 (unless (funcall test
663 (funcall key (funcall elt1 sequence1 state1))
664 (funcall key (funcall elt2 sequence2 state2)))
666 (setq state1 (funcall step1 sequence1 state1 from-end1))
667 (setq state2 (funcall step2 sequence2 state2 from-end2))))
668 (setq start-state2 (funcall step2 sequence2 start-state2 from-end2)))))))
670 (defgeneric sequence:delete
671 (item sequence &key from-end test test-not start end count key)
672 (:argument-precedence-order sequence item))
673 (defmethod sequence:delete (item (sequence sequence) &key
674 from-end test test-not (start 0) end count key)
675 (let ((test (sequence:canonize-test test test-not))
676 (key (sequence:canonize-key key))
678 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
679 (sequence :start start :end end :from-end from-end)
680 (declare (ignore limit1 endp1 elt1))
681 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
682 (sequence :start start :end end :from-end from-end)
685 (replace sequence sequence
686 :start1 start :end1 (- (length sequence) c)
687 :start2 (+ start c) :end2 (length sequence))
688 (unless (or (null end) (= end (length sequence)))
689 (replace sequence sequence :start2 end :start1 (- end c)
690 :end1 (- (length sequence) c))))
691 (sequence:adjust-sequence sequence (- (length sequence) c))))
692 (declare (truly-dynamic-extent #'finish))
694 ((funcall endp2 sequence state2 limit2 from-end2) (finish))
695 (let ((e (funcall elt2 sequence state2)))
697 (when (and count (>= c count))
699 (if (funcall test item (funcall key e))
702 (setq state2 (funcall step2 sequence state2 from-end2))
703 (when (funcall endp2 sequence state2 limit2 from-end2)
704 (return-from sequence:delete (finish)))
705 (setq e (funcall elt2 sequence state2)))
707 (funcall setelt1 e sequence state1))
708 (setq state1 (funcall step1 sequence state1 from-end1))
709 (setq state2 (funcall step2 sequence state2 from-end2))))))))
711 (defgeneric sequence:delete-if
712 (predicate sequence &key from-end start end count key)
713 (:argument-precedence-order sequence predicate))
714 (defmethod sequence:delete-if (predicate (sequence sequence) &key
715 from-end (start 0) end count key)
716 (let ((key (sequence:canonize-key key))
718 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
719 (sequence :start start :end end :from-end from-end)
720 (declare (ignore limit1 endp1 elt1))
721 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
722 (sequence :start start :end end :from-end from-end)
725 (replace sequence sequence
726 :start1 start :end1 (- (length sequence) c)
727 :start2 (+ start c) :end2 (length sequence))
728 (unless (or (null end) (= end (length sequence)))
729 (replace sequence sequence :start2 end :start1 (- end c)
730 :end1 (- (length sequence) c))))
731 (sequence:adjust-sequence sequence (- (length sequence) c))))
732 (declare (truly-dynamic-extent #'finish))
734 ((funcall endp2 sequence state2 limit2 from-end2) (finish))
735 (let ((e (funcall elt2 sequence state2)))
737 (when (and count (>= c count))
739 (if (funcall predicate (funcall key e))
742 (setq state2 (funcall step2 sequence state2 from-end2))
743 (when (funcall endp2 sequence state2 limit2 from-end2)
744 (return-from sequence:delete-if (finish)))
745 (setq e (funcall elt2 sequence state2)))
747 (funcall setelt1 e sequence state1))
748 (setq state1 (funcall step1 sequence state1 from-end1))
749 (setq state2 (funcall step2 sequence state2 from-end2))))))))
751 (defgeneric sequence:delete-if-not
752 (predicate sequence &key from-end start end count key)
753 (:argument-precedence-order sequence predicate))
754 (defmethod sequence:delete-if-not (predicate (sequence sequence) &key
755 from-end (start 0) end count key)
756 (let ((key (sequence:canonize-key key))
758 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
759 (sequence :start start :end end :from-end from-end)
760 (declare (ignore limit1 endp1 elt1))
761 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
762 (sequence :start start :end end :from-end from-end)
765 (replace sequence sequence
766 :start1 start :end1 (- (length sequence) c)
767 :start2 (+ start c) :end2 (length sequence))
768 (unless (or (null end) (= end (length sequence)))
769 (replace sequence sequence :start2 end :start1 (- end c)
770 :end1 (- (length sequence) c))))
771 (sequence:adjust-sequence sequence (- (length sequence) c))))
772 (declare (truly-dynamic-extent #'finish))
774 ((funcall endp2 sequence state2 limit2 from-end2) (finish))
775 (let ((e (funcall elt2 sequence state2)))
777 (when (and count (>= c count))
779 (if (funcall predicate (funcall key e))
783 (setq state2 (funcall step2 sequence state2 from-end2))
784 (when (funcall endp2 sequence state2 limit2 from-end2)
785 (return-from sequence:delete-if-not (finish)))
786 (setq e (funcall elt2 sequence state2)))))
787 (funcall setelt1 e sequence state1))
788 (setq state1 (funcall step1 sequence state1 from-end1))
789 (setq state2 (funcall step2 sequence state2 from-end2))))))))
791 (defgeneric sequence:remove
792 (item sequence &key from-end test test-not start end count key)
793 (:argument-precedence-order sequence item))
794 (defmethod sequence:remove (item (sequence sequence) &rest args &key
795 from-end test test-not (start 0) end count key)
796 (declare (truly-dynamic-extent args))
797 (declare (ignore from-end test test-not start end count key))
798 (let ((result (copy-seq sequence)))
799 (apply #'sequence:delete item result args)))
801 (defgeneric sequence:remove-if
802 (predicate sequence &key from-end start end count key)
803 (:argument-precedence-order sequence predicate))
804 (defmethod sequence:remove-if (predicate (sequence sequence) &rest args &key
805 from-end (start 0) end count key)
806 (declare (truly-dynamic-extent args))
807 (declare (ignore from-end start end count key))
808 (let ((result (copy-seq sequence)))
809 (apply #'sequence:delete-if predicate result args)))
811 (defgeneric sequence:remove-if-not
812 (predicate sequence &key from-end start end count key)
813 (:argument-precedence-order sequence predicate))
814 (defmethod sequence:remove-if-not (predicate (sequence sequence) &rest args
815 &key from-end (start 0) end count key)
816 (declare (truly-dynamic-extent args))
817 (declare (ignore from-end start end count key))
818 (let ((result (copy-seq sequence)))
819 (apply #'sequence:delete-if-not predicate result args)))
821 (defgeneric sequence:delete-duplicates
822 (sequence &key from-end test test-not start end key))
823 (defmethod sequence:delete-duplicates
824 ((sequence sequence) &key from-end test test-not (start 0) end key)
825 (let ((test (sequence:canonize-test test test-not))
826 (key (sequence:canonize-key key))
828 (sequence:with-sequence-iterator (state1 limit1 from-end1 step1 endp1 elt1 setelt1)
829 (sequence :start start :end end :from-end from-end)
830 (declare (ignore limit1 endp1 elt1))
831 (sequence:with-sequence-iterator (state2 limit2 from-end2 step2 endp2 elt2)
832 (sequence :start start :end end :from-end from-end)
835 (replace sequence sequence
836 :start1 start :end1 (- (length sequence) c)
837 :start2 (+ start c) :end2 (length sequence))
838 (unless (or (null end) (= end (length sequence)))
839 (replace sequence sequence :start2 end :start1 (- end c)
840 :end1 (- (length sequence) c))))
841 (sequence:adjust-sequence sequence (- (length sequence) c))))
842 (declare (truly-dynamic-extent #'finish))
843 (do ((end (or end (length sequence)))
845 ((funcall endp2 sequence state2 limit2 from-end2) (finish))
846 (let ((e (funcall elt2 sequence state2)))
848 ;; FIXME: replace with POSITION once position is
850 (if (> (count (funcall key e) sequence :test test :key key
851 :start (if from-end start (+ start step 1))
852 :end (if from-end (- end step 1) end))
857 (setq state2 (funcall step2 sequence state2 from-end2))
858 (when (funcall endp2 sequence state2 limit2 from-end2)
859 (return-from sequence:delete-duplicates (finish)))
860 (setq e (funcall elt2 sequence state2)))
863 (funcall setelt1 e sequence state1))
864 (setq state1 (funcall step1 sequence state1 from-end1))
865 (setq state2 (funcall step2 sequence state2 from-end2))))))))
867 (defgeneric sequence:remove-duplicates
868 (sequence &key from-end test test-not start end key))
869 (defmethod sequence:remove-duplicates
870 ((sequence sequence) &rest args &key from-end test test-not (start 0) end key)
871 (declare (truly-dynamic-extent args))
872 (declare (ignore from-end test test-not start end key))
873 (let ((result (copy-seq sequence)))
874 (apply #'sequence:delete-duplicates result args)))
876 (defgeneric sequence:sort (sequence predicate &key key))
877 (defmethod sequence:sort ((sequence sequence) predicate &rest args &key key)
878 (declare (truly-dynamic-extent args))
879 (declare (ignore key))
880 (let* ((length (length sequence))
881 (vector (make-array length)))
882 (sequence:with-sequence-iterator (state limit from-end step endp elt)
884 (declare (ignore limit endp))
887 (setf (aref vector i) (funcall elt sequence state))
888 (setq state (funcall step sequence state from-end))))
889 (apply #'sort vector predicate args)
890 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
892 (declare (ignore limit endp elt))
894 ((>= i length) sequence)
895 (funcall setelt (aref vector i) sequence state)
896 (setq state (funcall step sequence state from-end))))))
898 (defgeneric sequence:stable-sort (sequence predicate &key key))
899 (defmethod sequence:stable-sort
900 ((sequence sequence) predicate &rest args &key key)
901 (declare (truly-dynamic-extent args))
902 (declare (ignore key))
903 (let* ((length (length sequence))
904 (vector (make-array length)))
905 (sequence:with-sequence-iterator (state limit from-end step endp elt)
907 (declare (ignore limit endp))
910 (setf (aref vector i) (funcall elt sequence state))
911 (setq state (funcall step sequence state from-end))))
912 (apply #'stable-sort vector predicate args)
913 (sequence:with-sequence-iterator (state limit from-end step endp elt setelt)
915 (declare (ignore limit endp elt))
917 ((>= i length) sequence)
918 (funcall setelt (aref vector i) sequence state)
919 (setq state (funcall step sequence state from-end))))))