sequences.lisp - clic - Clic is an command line interactive client for gopher w… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
sequences.lisp (24604B) | |
--- | |
1 (in-package :alexandria) | |
2 | |
3 ;; Make these inlinable by declaiming them INLINE here and some of them | |
4 ;; NOTINLINE at the end of the file. Exclude functions that have a compi… | |
5 ;; macro, because NOTINLINE is required to prevent compiler-macro expans… | |
6 (declaim (inline copy-sequence sequence-of-length-p)) | |
7 | |
8 (defun sequence-of-length-p (sequence length) | |
9 "Return true if SEQUENCE is a sequence of length LENGTH. Signals an er… | |
10 SEQUENCE is not a sequence. Returns FALSE for circular lists." | |
11 (declare (type array-index length) | |
12 #-lispworks (inline length) | |
13 (optimize speed)) | |
14 (etypecase sequence | |
15 (null | |
16 (zerop length)) | |
17 (cons | |
18 (let ((n (1- length))) | |
19 (unless (minusp n) | |
20 (let ((tail (nthcdr n sequence))) | |
21 (and tail | |
22 (null (cdr tail))))))) | |
23 (vector | |
24 (= length (length sequence))) | |
25 (sequence | |
26 (= length (length sequence))))) | |
27 | |
28 (defun rotate-tail-to-head (sequence n) | |
29 (declare (type (integer 1) n)) | |
30 (if (listp sequence) | |
31 (let ((m (mod n (proper-list-length sequence)))) | |
32 (if (null (cdr sequence)) | |
33 sequence | |
34 (let* ((tail (last sequence (+ m 1))) | |
35 (last (cdr tail))) | |
36 (setf (cdr tail) nil) | |
37 (nconc last sequence)))) | |
38 (let* ((len (length sequence)) | |
39 (m (mod n len)) | |
40 (tail (subseq sequence (- len m)))) | |
41 (replace sequence sequence :start1 m :start2 0) | |
42 (replace sequence tail) | |
43 sequence))) | |
44 | |
45 (defun rotate-head-to-tail (sequence n) | |
46 (declare (type (integer 1) n)) | |
47 (if (listp sequence) | |
48 (let ((m (mod (1- n) (proper-list-length sequence)))) | |
49 (if (null (cdr sequence)) | |
50 sequence | |
51 (let* ((headtail (nthcdr m sequence)) | |
52 (tail (cdr headtail))) | |
53 (setf (cdr headtail) nil) | |
54 (nconc tail sequence)))) | |
55 (let* ((len (length sequence)) | |
56 (m (mod n len)) | |
57 (head (subseq sequence 0 m))) | |
58 (replace sequence sequence :start1 0 :start2 m) | |
59 (replace sequence head :start1 (- len m)) | |
60 sequence))) | |
61 | |
62 (defun rotate (sequence &optional (n 1)) | |
63 "Returns a sequence of the same type as SEQUENCE, with the elements of | |
64 SEQUENCE rotated by N: N elements are moved from the end of the sequence… | |
65 the front if N is positive, and -N elements moved from the front to the … | |
66 N is negative. SEQUENCE must be a proper sequence. N must be an integer, | |
67 defaulting to 1. | |
68 | |
69 If absolute value of N is greater then the length of the sequence, the r… | |
70 are identical to calling ROTATE with | |
71 | |
72 (* (signum n) (mod n (length sequence))). | |
73 | |
74 Note: the original sequence may be destructively altered, and result seq… | |
75 share structure with it." | |
76 (if (plusp n) | |
77 (rotate-tail-to-head sequence n) | |
78 (if (minusp n) | |
79 (rotate-head-to-tail sequence (- n)) | |
80 sequence))) | |
81 | |
82 (defun shuffle (sequence &key (start 0) end) | |
83 "Returns a random permutation of SEQUENCE bounded by START and END. | |
84 Original sequence may be destructively modified, and (if it contains | |
85 CONS or lists themselv) share storage with the original one. | |
86 Signals an error if SEQUENCE is not a proper sequence." | |
87 (declare (type fixnum start) | |
88 (type (or fixnum null) end)) | |
89 (etypecase sequence | |
90 (list | |
91 (let* ((end (or end (proper-list-length sequence))) | |
92 (n (- end start))) | |
93 (do ((tail (nthcdr start sequence) (cdr tail))) | |
94 ((zerop n)) | |
95 (rotatef (car tail) (car (nthcdr (random n) tail))) | |
96 (decf n)))) | |
97 (vector | |
98 (let ((end (or end (length sequence)))) | |
99 (loop for i from start below end | |
100 do (rotatef (aref sequence i) | |
101 (aref sequence (+ i (random (- end i)))))))) | |
102 (sequence | |
103 (let ((end (or end (length sequence)))) | |
104 (loop for i from (- end 1) downto start | |
105 do (rotatef (elt sequence i) | |
106 (elt sequence (+ i (random (- end i))))))))) | |
107 sequence) | |
108 | |
109 (defun random-elt (sequence &key (start 0) end) | |
110 "Returns a random element from SEQUENCE bounded by START and END. Sign… | |
111 error if the SEQUENCE is not a proper non-empty sequence, or if END and … | |
112 are not proper bounding index designators for SEQUENCE." | |
113 (declare (sequence sequence) (fixnum start) (type (or fixnum null) end… | |
114 (let* ((size (if (listp sequence) | |
115 (proper-list-length sequence) | |
116 (length sequence))) | |
117 (end2 (or end size))) | |
118 (cond ((zerop size) | |
119 (error 'type-error | |
120 :datum sequence | |
121 :expected-type `(and sequence (not (satisfies emptyp))… | |
122 ((not (and (<= 0 start) (< start end2) (<= end2 size))) | |
123 (error 'simple-type-error | |
124 :datum (cons start end) | |
125 :expected-type `(cons (integer 0 (,end2)) | |
126 (or null (integer (,start) ,size… | |
127 :format-control "~@<~S and ~S are not valid bounding i… | |
128 a sequence of length ~S.~:@>" | |
129 :format-arguments (list start end size))) | |
130 (t | |
131 (let ((index (+ start (random (- end2 start))))) | |
132 (elt sequence index)))))) | |
133 | |
134 (declaim (inline remove/swapped-arguments)) | |
135 (defun remove/swapped-arguments (sequence item &rest keyword-arguments) | |
136 (apply #'remove item sequence keyword-arguments)) | |
137 | |
138 (define-modify-macro removef (item &rest keyword-arguments) | |
139 remove/swapped-arguments | |
140 "Modify-macro for REMOVE. Sets place designated by the first argument … | |
141 the result of calling REMOVE with ITEM, place, and the KEYWORD-ARGUMENTS… | |
142 | |
143 (declaim (inline delete/swapped-arguments)) | |
144 (defun delete/swapped-arguments (sequence item &rest keyword-arguments) | |
145 (apply #'delete item sequence keyword-arguments)) | |
146 | |
147 (define-modify-macro deletef (item &rest keyword-arguments) | |
148 delete/swapped-arguments | |
149 "Modify-macro for DELETE. Sets place designated by the first argument … | |
150 the result of calling DELETE with ITEM, place, and the KEYWORD-ARGUMENTS… | |
151 | |
152 (deftype proper-sequence () | |
153 "Type designator for proper sequences, that is proper lists and sequen… | |
154 that are not lists." | |
155 `(or proper-list | |
156 (and (not list) sequence))) | |
157 | |
158 (eval-when (:compile-toplevel :load-toplevel :execute) | |
159 (when (and (find-package '#:sequence) | |
160 (find-symbol (string '#:emptyp) '#:sequence)) | |
161 (pushnew 'sequence-emptyp *features*))) | |
162 | |
163 #-alexandria::sequence-emptyp | |
164 (defun emptyp (sequence) | |
165 "Returns true if SEQUENCE is an empty sequence. Signals an error if SE… | |
166 is not a sequence." | |
167 (etypecase sequence | |
168 (list (null sequence)) | |
169 (sequence (zerop (length sequence))))) | |
170 | |
171 #+alexandria::sequence-emptyp | |
172 (declaim (ftype (function (sequence) (values boolean &optional)) emptyp)) | |
173 #+alexandria::sequence-emptyp | |
174 (setf (symbol-function 'emptyp) (symbol-function 'sequence:emptyp)) | |
175 #+alexandria::sequence-emptyp | |
176 (define-compiler-macro emptyp (sequence) | |
177 `(sequence:emptyp ,sequence)) | |
178 | |
179 (defun length= (&rest sequences) | |
180 "Takes any number of sequences or integers in any order. Returns true … | |
181 the length of all the sequences and the integers are equal. Hint: there'… | |
182 compiler macro that expands into more efficient code if the first argume… | |
183 is a literal integer." | |
184 (declare (dynamic-extent sequences) | |
185 (inline sequence-of-length-p) | |
186 (optimize speed)) | |
187 (unless (cdr sequences) | |
188 (error "You must call LENGTH= with at least two arguments")) | |
189 ;; There's room for optimization here: multiple list arguments could be | |
190 ;; traversed in parallel. | |
191 (let* ((first (pop sequences)) | |
192 (current (if (integerp first) | |
193 first | |
194 (length first)))) | |
195 (declare (type array-index current)) | |
196 (dolist (el sequences) | |
197 (if (integerp el) | |
198 (unless (= el current) | |
199 (return-from length= nil)) | |
200 (unless (sequence-of-length-p el current) | |
201 (return-from length= nil))))) | |
202 t) | |
203 | |
204 (define-compiler-macro length= (&whole form length &rest sequences) | |
205 (cond | |
206 ((zerop (length sequences)) | |
207 form) | |
208 (t | |
209 (let ((optimizedp (integerp length))) | |
210 (with-unique-names (tmp current) | |
211 (declare (ignorable current)) | |
212 `(locally | |
213 (declare (inline sequence-of-length-p)) | |
214 (let ((,tmp) | |
215 ,@(unless optimizedp | |
216 `((,current ,length)))) | |
217 ,@(unless optimizedp | |
218 `((unless (integerp ,current) | |
219 (setf ,current (length ,current))))) | |
220 (and | |
221 ,@(loop | |
222 :for sequence :in sequences | |
223 :collect `(progn | |
224 (setf ,tmp ,sequence) | |
225 (if (integerp ,tmp) | |
226 (= ,tmp ,(if optimizedp | |
227 length | |
228 current)) | |
229 (sequence-of-length-p ,tmp ,(if opti… | |
230 leng… | |
231 curr… | |
232 | |
233 (defun copy-sequence (type sequence) | |
234 "Returns a fresh sequence of TYPE, which has the same elements as | |
235 SEQUENCE." | |
236 (if (typep sequence type) | |
237 (copy-seq sequence) | |
238 (coerce sequence type))) | |
239 | |
240 (defun first-elt (sequence) | |
241 "Returns the first element of SEQUENCE. Signals a type-error if SEQUEN… | |
242 not a sequence, or is an empty sequence." | |
243 ;; Can't just directly use ELT, as it is not guaranteed to signal the | |
244 ;; type-error. | |
245 (cond ((consp sequence) | |
246 (car sequence)) | |
247 ((and (typep sequence 'sequence) (not (emptyp sequence))) | |
248 (elt sequence 0)) | |
249 (t | |
250 (error 'type-error | |
251 :datum sequence | |
252 :expected-type '(and sequence (not (satisfies emptyp)))… | |
253 | |
254 (defun (setf first-elt) (object sequence) | |
255 "Sets the first element of SEQUENCE. Signals a type-error if SEQUENCE … | |
256 not a sequence, is an empty sequence, or if OBJECT cannot be stored in S… | |
257 ;; Can't just directly use ELT, as it is not guaranteed to signal the | |
258 ;; type-error. | |
259 (cond ((consp sequence) | |
260 (setf (car sequence) object)) | |
261 ((and (typep sequence 'sequence) (not (emptyp sequence))) | |
262 (setf (elt sequence 0) object)) | |
263 (t | |
264 (error 'type-error | |
265 :datum sequence | |
266 :expected-type '(and sequence (not (satisfies emptyp))))… | |
267 | |
268 (defun last-elt (sequence) | |
269 "Returns the last element of SEQUENCE. Signals a type-error if SEQUENC… | |
270 not a proper sequence, or is an empty sequence." | |
271 ;; Can't just directly use ELT, as it is not guaranteed to signal the | |
272 ;; type-error. | |
273 (let ((len 0)) | |
274 (cond ((consp sequence) | |
275 (lastcar sequence)) | |
276 ((and (typep sequence '(and sequence (not list))) (plusp (setf… | |
277 (elt sequence (1- len))) | |
278 (t | |
279 (error 'type-error | |
280 :datum sequence | |
281 :expected-type '(and proper-sequence (not (satisfies e… | |
282 | |
283 (defun (setf last-elt) (object sequence) | |
284 "Sets the last element of SEQUENCE. Signals a type-error if SEQUENCE i… | |
285 sequence, is an empty sequence, or if OBJECT cannot be stored in SEQUENC… | |
286 (let ((len 0)) | |
287 (cond ((consp sequence) | |
288 (setf (lastcar sequence) object)) | |
289 ((and (typep sequence '(and sequence (not list))) (plusp (setf… | |
290 (setf (elt sequence (1- len)) object)) | |
291 (t | |
292 (error 'type-error | |
293 :datum sequence | |
294 :expected-type '(and proper-sequence (not (satisfies e… | |
295 | |
296 (defun starts-with-subseq (prefix sequence &rest args | |
297 &key | |
298 (return-suffix nil return-suffix-supplied-p) | |
299 &allow-other-keys) | |
300 "Test whether the first elements of SEQUENCE are the same (as per TEST… | |
301 | |
302 If RETURN-SUFFIX is T the function returns, as a second value, a | |
303 sub-sequence or displaced array pointing to the sequence after PREFIX." | |
304 (declare (dynamic-extent args)) | |
305 (let ((sequence-length (length sequence)) | |
306 (prefix-length (length prefix))) | |
307 (when (< sequence-length prefix-length) | |
308 (return-from starts-with-subseq (values nil nil))) | |
309 (flet ((make-suffix (start) | |
310 (when return-suffix | |
311 (cond | |
312 ((not (arrayp sequence)) | |
313 (if start | |
314 (subseq sequence start) | |
315 (subseq sequence 0 0))) | |
316 ((not start) | |
317 (make-array 0 | |
318 :element-type (array-element-type sequence) | |
319 :adjustable nil)) | |
320 (t | |
321 (make-array (- sequence-length start) | |
322 :element-type (array-element-type sequence) | |
323 :displaced-to sequence | |
324 :displaced-index-offset start | |
325 :adjustable nil)))))) | |
326 (let ((mismatch (apply #'mismatch prefix sequence | |
327 (if return-suffix-supplied-p | |
328 (remove-from-plist args :return-suffix) | |
329 args)))) | |
330 (cond | |
331 ((not mismatch) | |
332 (values t (make-suffix nil))) | |
333 ((= mismatch prefix-length) | |
334 (values t (make-suffix mismatch))) | |
335 (t | |
336 (values nil nil))))))) | |
337 | |
338 (defun ends-with-subseq (suffix sequence &key (test #'eql)) | |
339 "Test whether SEQUENCE ends with SUFFIX. In other words: return true if | |
340 the last (length SUFFIX) elements of SEQUENCE are equal to SUFFIX." | |
341 (let ((sequence-length (length sequence)) | |
342 (suffix-length (length suffix))) | |
343 (when (< sequence-length suffix-length) | |
344 ;; if SEQUENCE is shorter than SUFFIX, then SEQUENCE can't end wit… | |
345 (return-from ends-with-subseq nil)) | |
346 (loop for sequence-index from (- sequence-length suffix-length) belo… | |
347 for suffix-index from 0 below suffix-length | |
348 when (not (funcall test (elt sequence sequence-index) (elt suf… | |
349 do (return-from ends-with-subseq nil) | |
350 finally (return t)))) | |
351 | |
352 (defun starts-with (object sequence &key (test #'eql) (key #'identity)) | |
353 "Returns true if SEQUENCE is a sequence whose first element is EQL to … | |
354 Returns NIL if the SEQUENCE is not a sequence or is an empty sequence." | |
355 (let ((first-elt (typecase sequence | |
356 (cons (car sequence)) | |
357 (sequence | |
358 (if (emptyp sequence) | |
359 (return-from starts-with nil) | |
360 (elt sequence 0))) | |
361 (t | |
362 (return-from starts-with nil))))) | |
363 (funcall test (funcall key first-elt) object))) | |
364 | |
365 (defun ends-with (object sequence &key (test #'eql) (key #'identity)) | |
366 "Returns true if SEQUENCE is a sequence whose last element is EQL to O… | |
367 Returns NIL if the SEQUENCE is not a sequence or is an empty sequence. S… | |
368 an error if SEQUENCE is an improper list." | |
369 (let ((last-elt (typecase sequence | |
370 (cons | |
371 (lastcar sequence)) ; signals for improper lists | |
372 (sequence | |
373 ;; Can't use last-elt, as that signals an error | |
374 ;; for empty sequences | |
375 (let ((len (length sequence))) | |
376 (if (plusp len) | |
377 (elt sequence (1- len)) | |
378 (return-from ends-with nil)))) | |
379 (t | |
380 (return-from ends-with nil))))) | |
381 (funcall test (funcall key last-elt) object))) | |
382 | |
383 (defun map-combinations (function sequence &key (start 0) end length (co… | |
384 "Calls FUNCTION with each combination of LENGTH constructable from the | |
385 elements of the subsequence of SEQUENCE delimited by START and END. START | |
386 defaults to 0, END to length of SEQUENCE, and LENGTH to the length of the | |
387 delimited subsequence. (So unless LENGTH is specified there is only a si… | |
388 combination, which has the same elements as the delimited subsequence.) … | |
389 COPY is true (the default) each combination is freshly allocated. If COP… | |
390 false all combinations are EQ to each other, in which case consequences … | |
391 unspecified if a combination is modified by FUNCTION." | |
392 (let* ((end (or end (length sequence))) | |
393 (size (- end start)) | |
394 (length (or length size)) | |
395 (combination (subseq sequence 0 length)) | |
396 (function (ensure-function function))) | |
397 (if (= length size) | |
398 (funcall function combination) | |
399 (flet ((call () | |
400 (funcall function (if copy | |
401 (copy-seq combination) | |
402 combination)))) | |
403 (etypecase sequence | |
404 ;; When dealing with lists we prefer walking back and | |
405 ;; forth instead of using indexes. | |
406 (list | |
407 (labels ((combine-list (c-tail o-tail) | |
408 (if (not c-tail) | |
409 (call) | |
410 (do ((tail o-tail (cdr tail))) | |
411 ((not tail)) | |
412 (setf (car c-tail) (car tail)) | |
413 (combine-list (cdr c-tail) (cdr tail)))))) | |
414 (combine-list combination (nthcdr start sequence)))) | |
415 (vector | |
416 (labels ((combine (count start) | |
417 (if (zerop count) | |
418 (call) | |
419 (loop for i from start below end | |
420 do (let ((j (- count 1))) | |
421 (setf (aref combination j) (aref … | |
422 (combine j (+ i 1))))))) | |
423 (combine length start))) | |
424 (sequence | |
425 (labels ((combine (count start) | |
426 (if (zerop count) | |
427 (call) | |
428 (loop for i from start below end | |
429 do (let ((j (- count 1))) | |
430 (setf (elt combination j) (elt se… | |
431 (combine j (+ i 1))))))) | |
432 (combine length start))))))) | |
433 sequence) | |
434 | |
435 (defun map-permutations (function sequence &key (start 0) end length (co… | |
436 "Calls function with each permutation of LENGTH constructable | |
437 from the subsequence of SEQUENCE delimited by START and END. START | |
438 defaults to 0, END to length of the sequence, and LENGTH to the | |
439 length of the delimited subsequence." | |
440 (let* ((end (or end (length sequence))) | |
441 (size (- end start)) | |
442 (length (or length size))) | |
443 (labels ((permute (seq n) | |
444 (let ((n-1 (- n 1))) | |
445 (if (zerop n-1) | |
446 (funcall function (if copy | |
447 (copy-seq seq) | |
448 seq)) | |
449 (loop for i from 0 upto n-1 | |
450 do (permute seq n-1) | |
451 (if (evenp n-1) | |
452 (rotatef (elt seq 0) (elt seq n-1)) | |
453 (rotatef (elt seq i) (elt seq n-1))))))) | |
454 (permute-sequence (seq) | |
455 (permute seq length))) | |
456 (if (= length size) | |
457 ;; Things are simple if we need to just permute the | |
458 ;; full START-END range. | |
459 (permute-sequence (subseq sequence start end)) | |
460 ;; Otherwise we need to generate all the combinations | |
461 ;; of LENGTH in the START-END range, and then permute | |
462 ;; a copy of the result: can't permute the combination | |
463 ;; directly, as they share structure with each other. | |
464 (let ((permutation (subseq sequence 0 length))) | |
465 (flet ((permute-combination (combination) | |
466 (permute-sequence (replace permutation combination)… | |
467 (declare (dynamic-extent #'permute-combination)) | |
468 (map-combinations #'permute-combination sequence | |
469 :start start | |
470 :end end | |
471 :length length | |
472 :copy nil))))))) | |
473 | |
474 (defun map-derangements (function sequence &key (start 0) end (copy t)) | |
475 "Calls FUNCTION with each derangement of the subsequence of SEQUENCE d… | |
476 by the bounding index designators START and END. Derangement is a permut… | |
477 of the sequence where no element remains in place. SEQUENCE is not modif… | |
478 but individual derangements are EQ to each other. Consequences are unspe… | |
479 if calling FUNCTION modifies either the derangement or SEQUENCE." | |
480 (let* ((end (or end (length sequence))) | |
481 (size (- end start)) | |
482 ;; We don't really care about the elements here. | |
483 (derangement (subseq sequence 0 size)) | |
484 ;; Bitvector that has 1 for elements that have been deranged. | |
485 (mask (make-array size :element-type 'bit :initial-element 0))) | |
486 (declare (dynamic-extent mask)) | |
487 ;; ad hoc algorith | |
488 (labels ((derange (place n) | |
489 ;; Perform one recursive step in deranging the | |
490 ;; sequence: PLACE is index of the original sequence | |
491 ;; to derange to another index, and N is the number of | |
492 ;; indexes not yet deranged. | |
493 (if (zerop n) | |
494 (funcall function (if copy | |
495 (copy-seq derangement) | |
496 derangement)) | |
497 ;; Itarate over the indexes I of the subsequence to | |
498 ;; derange: if I != PLACE and I has not yet been | |
499 ;; deranged by an earlier call put the element from | |
500 ;; PLACE to I, mark I as deranged, and recurse, | |
501 ;; finally removing the mark. | |
502 (loop for i from 0 below size | |
503 do | |
504 (unless (or (= place (+ i start)) (not (zerop (… | |
505 (setf (elt derangement i) (elt sequence place) | |
506 (bit mask i) 1) | |
507 (derange (1+ place) (1- n)) | |
508 (setf (bit mask i) 0)))))) | |
509 (derange start size) | |
510 sequence))) | |
511 | |
512 (declaim (notinline sequence-of-length-p)) | |
513 | |
514 (defun extremum (sequence predicate &key key (start 0) end) | |
515 "Returns the element of SEQUENCE that would appear first if the subseq… | |
516 bounded by START and END was sorted using PREDICATE and KEY. | |
517 | |
518 EXTREMUM determines the relationship between two elements of SEQUENCE by… | |
519 the PREDICATE function. PREDICATE should return true if and only if the … | |
520 argument is strictly less than the second one (in some appropriate sense… | |
521 arguments X and Y are considered to be equal if (FUNCALL PREDICATE X Y) | |
522 and (FUNCALL PREDICATE Y X) are both false. | |
523 | |
524 The arguments to the PREDICATE function are computed from elements of SE… | |
525 using the KEY function, if supplied. If KEY is not supplied or is NIL, t… | |
526 sequence element itself is used. | |
527 | |
528 If SEQUENCE is empty, NIL is returned." | |
529 (let* ((pred-fun (ensure-function predicate)) | |
530 (key-fun (unless (or (not key) (eq key 'identity) (eq key #'ide… | |
531 (ensure-function key))) | |
532 (real-end (or end (length sequence)))) | |
533 (cond ((> real-end start) | |
534 (if key-fun | |
535 (flet ((reduce-keys (a b) | |
536 (if (funcall pred-fun | |
537 (funcall key-fun a) | |
538 (funcall key-fun b)) | |
539 a | |
540 b))) | |
541 (declare (dynamic-extent #'reduce-keys)) | |
542 (reduce #'reduce-keys sequence :start start :end real-e… | |
543 (flet ((reduce-elts (a b) | |
544 (if (funcall pred-fun a b) | |
545 a | |
546 b))) | |
547 (declare (dynamic-extent #'reduce-elts)) | |
548 (reduce #'reduce-elts sequence :start start :end real-e… | |
549 ((= real-end start) | |
550 nil) | |
551 (t | |
552 (error "Invalid bounding indexes for sequence of length ~S: ~… | |
553 (length sequence) | |
554 :start start | |
555 :end end))))) |