Initial revision

xml/split-sequence.lisp

@@ -0,0 +1,44 @@
+;;; 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))))))