xml/split-sequence.lisp

   1 ;;; This code was based on Arthur Lemmens' in
   2 ;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
   3
   4 (in-package :cxml)
   5
   6 (defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied))
   7   (let ((len (length seq))
   8         (other-keys (when key-supplied
   9                       (list :key key))))
  10     (unless end (setq end len))
  11     (if from-end
  12         (loop for right = end then left
  13               for left = (max (or (apply #'position-if predicate seq
  14                                          :end right
  15                                          :from-end t
  16                                          other-keys)
  17                                   -1)
  18                               (1- start))
  19               unless (and (= right (1+ left))
  20                           remove-empty-subseqs) ; empty subseq we don't want
  21               if (and count (>= nr-elts count))
  22               ;; We can't take any more. Return now.
  23               return (values (nreverse subseqs) right)
  24               else
  25               collect (subseq seq (1+ left) right) into subseqs
  26               and sum 1 into nr-elts
  27               until (< left start)
  28               finally (return (values (nreverse subseqs) (1+ left))))
  29       (loop for left = start then (+ right 1)
  30             for right = (min (or (apply #'position-if predicate seq
  31                                         :start left
  32                                         other-keys)
  33                                  len)
  34                              end)
  35             unless (and (= right left)
  36                         remove-empty-subseqs) ; empty subseq we don't want
  37             if (and count (>= nr-elts count))
  38             ;; We can't take any more. Return now.
  39             return (values subseqs left)
  40             else
  41             collect (subseq seq left right) into subseqs
  42             and sum 1 into nr-elts
  43             until (>= right end)
  44             finally (return (values subseqs right))))))