1 | ;;;; SPLIT-SEQUENCE |
---|
2 | ;;; |
---|
3 | ;;; This code was based on Arthur Lemmens' in |
---|
4 | ;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>; |
---|
5 | ;;; |
---|
6 | |
---|
7 | (in-package #:asdf-install) |
---|
8 | |
---|
9 | (defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) |
---|
10 | "Return a list of subsequences in seq delimited by items satisfying |
---|
11 | predicate. |
---|
12 | |
---|
13 | If :remove-empty-subseqs is NIL, empty subsequences will be included |
---|
14 | in the result; otherwise they will be discarded. All other keywords |
---|
15 | work analogously to those for CL:SUBSTITUTE-IF. In particular, the |
---|
16 | behaviour of :from-end is possibly different from other versions of |
---|
17 | this function; :from-end values of NIL and T are equivalent unless |
---|
18 | :count is supplied. The second return value is an index suitable as an |
---|
19 | argument to CL:SUBSEQ into the sequence indicating where processing |
---|
20 | stopped." |
---|
21 | (let ((len (length seq)) |
---|
22 | (other-keys (when key-supplied |
---|
23 | (list :key key)))) |
---|
24 | (unless end (setq end len)) |
---|
25 | (if from-end |
---|
26 | (loop for right = end then left |
---|
27 | for left = (max (or (apply #'position-if predicate seq |
---|
28 | :end right |
---|
29 | :from-end t |
---|
30 | other-keys) |
---|
31 | -1) |
---|
32 | (1- start)) |
---|
33 | unless (and (= right (1+ left)) |
---|
34 | remove-empty-subseqs) ; empty subseq we don't want |
---|
35 | if (and count (>= nr-elts count)) |
---|
36 | ;; We can't take any more. Return now. |
---|
37 | return (values (nreverse subseqs) right) |
---|
38 | else |
---|
39 | collect (subseq seq (1+ left) right) into subseqs |
---|
40 | and sum 1 into nr-elts |
---|
41 | until (< left start) |
---|
42 | finally (return (values (nreverse subseqs) (1+ left)))) |
---|
43 | (loop for left = start then (+ right 1) |
---|
44 | for right = (min (or (apply #'position-if predicate seq |
---|
45 | :start left |
---|
46 | other-keys) |
---|
47 | len) |
---|
48 | end) |
---|
49 | unless (and (= right left) |
---|
50 | remove-empty-subseqs) ; empty subseq we don't want |
---|
51 | if (and count (>= nr-elts count)) |
---|
52 | ;; We can't take any more. Return now. |
---|
53 | return (values subseqs left) |
---|
54 | else |
---|
55 | collect (subseq seq left right) into subseqs |
---|
56 | and sum 1 into nr-elts |
---|
57 | until (>= right end) |
---|
58 | finally (return (values subseqs right)))))) |
---|
59 | |
---|