source: release/1.2/source/tools/asdf-install/split-sequence.lisp @ 9219

Last change on this file since 9219 was 9219, checked in by gb, 11 years ago

synch from trunk

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.3 KB
Line 
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
11predicate.
12
13If :remove-empty-subseqs is NIL, empty subsequences will be included
14in the result; otherwise they will be discarded.  All other keywords
15work analogously to those for CL:SUBSTITUTE-IF.  In particular, the
16behaviour of :from-end is possibly different from other versions of
17this 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
19argument to CL:SUBSEQ into the sequence indicating where processing
20stopped."
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
Note: See TracBrowser for help on using the repository browser.