45 lines
1.7 KiB
Common Lisp
45 lines
1.7 KiB
Common Lisp
;;; This code was based on Arthur Lemmens' in
|
|
;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>;
|
|
|
|
(in-package :cxml)
|
|
|
|
(defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied))
|
|
(let ((len (length seq))
|
|
(other-keys (when key-supplied
|
|
(list :key key))))
|
|
(unless end (setq end len))
|
|
(if from-end
|
|
(loop for right = end then left
|
|
for left = (max (or (apply #'position-if predicate seq
|
|
:end right
|
|
:from-end t
|
|
other-keys)
|
|
-1)
|
|
(1- start))
|
|
unless (and (= right (1+ left))
|
|
remove-empty-subseqs) ; empty subseq we don't want
|
|
if (and count (>= nr-elts count))
|
|
;; We can't take any more. Return now.
|
|
return (values (nreverse subseqs) right)
|
|
else
|
|
collect (subseq seq (1+ left) right) into subseqs
|
|
and sum 1 into nr-elts
|
|
until (< left start)
|
|
finally (return (values (nreverse subseqs) (1+ left))))
|
|
(loop for left = start then (+ right 1)
|
|
for right = (min (or (apply #'position-if predicate seq
|
|
:start left
|
|
other-keys)
|
|
len)
|
|
end)
|
|
unless (and (= right left)
|
|
remove-empty-subseqs) ; empty subseq we don't want
|
|
if (and count (>= nr-elts count))
|
|
;; We can't take any more. Return now.
|
|
return (values subseqs left)
|
|
else
|
|
collect (subseq seq left right) into subseqs
|
|
and sum 1 into nr-elts
|
|
until (>= right end)
|
|
finally (return (values subseqs right))))))
|