sbcl stuff

sbcl/.quicklisp/dists/quicklisp/software/split-sequence-v2.0.0/list.lisp

@@ -0,0 +1,116 @@
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+
+(in-package :split-sequence)
+
+(declaim (inline
+          collect-until count-while
+          split-list split-list-if split-list-if-not
+          split-list-from-end split-list-from-start split-list-internal))
+
+(declaim (ftype (function (&rest t) (values list unsigned-byte))
+                split-list split-list-if split-list-if-not))
+
+(declaim (ftype (function (function list unsigned-byte (or null unsigned-byte) (or null unsigned-byte)
+                                    boolean)
+                          (values list unsigned-byte))
+                split-list-from-start split-list-from-end split-list-internal))
+
+(defun collect-until (predicate list end)
+  "Collect elements from LIST until one that satisfies PREDICATE is found.
+
+  At most END elements will be examined. If END is null, all elements will be examined.
+
+  Returns four values:
+
+  * The collected items.
+  * The remaining items.
+  * The number of elements examined.
+  * Whether the search ended by running off the end, instead of by finding a delimiter."
+  (let ((examined 0)
+        (found nil))
+    (flet ((examine (value)
+             (incf examined)
+             (setf found (funcall predicate value))))
+      (loop :for (value . remaining) :on list
+            :until (eql examined end)
+            :until (examine value)
+            :collect value :into result
+            :finally (return (values result
+                                     remaining
+                                     examined
+                                     (and (not found)
+                                          (or (null end)
+                                              (= end examined)))))))))
+
+(defun count-while (predicate list end)
+  "Count the number of elements satisfying PREDICATE at the beginning of LIST.
+
+  At most END elements will be counted. If END is null, all elements will be examined."
+  (if end
+      (loop :for value :in list
+            :for i :below end
+            :while (funcall predicate value)
+            :summing 1)
+      (loop :for value :in list
+            :while (funcall predicate value)
+            :summing 1)))
+
+(defun split-list-internal (predicate list start end count remove-empty-subseqs)
+  (let ((count count)
+        (done nil)
+        (index start)
+        (end (when end (- end start)))
+        (list (nthcdr start list)))
+    (flet ((should-collect-p (chunk)
+             (unless (and remove-empty-subseqs (null chunk))
+               (when (numberp count) (decf count))
+               t))
+           (gather-chunk ()
+             (multiple-value-bind (chunk remaining examined ran-off-end)
+                 (collect-until predicate list end)
+               (incf index examined)
+               (when end (decf end examined))
+               (setf list remaining
+                     done ran-off-end)
+               chunk)))
+      (values (loop :with chunk
+                    :until (or done (eql 0 count))
+                    :do (setf chunk (gather-chunk))
+                    :when (should-collect-p chunk)
+                      :collect chunk)
+              (+ index
+                 (if remove-empty-subseqs
+                     (count-while predicate list end) ; chew off remaining empty seqs
+                     0))))))
+
+(defun split-list-from-end (predicate list start end count remove-empty-subseqs)
+  (let ((length (length list)))
+    (multiple-value-bind (result index)
+        (split-list-internal predicate (reverse list)
+                             (if end (- length end) 0)
+                             (- length start) count remove-empty-subseqs)
+      (loop :for cons on result
+            :for car := (car cons)
+            :do (setf (car cons) (nreverse car)))
+      (values (nreverse result) (- length index)))))
+
+(defun split-list-from-start (predicate list start end count remove-empty-subseqs)
+  (split-list-internal predicate list start end count remove-empty-subseqs))
+
+(defun split-list-if (predicate list start end from-end count remove-empty-subseqs key)
+  (let ((predicate (lambda (x) (funcall predicate (funcall key x)))))
+    (if from-end
+        (split-list-from-end predicate list start end count remove-empty-subseqs)
+        (split-list-from-start predicate list start end count remove-empty-subseqs))))
+
+(defun split-list-if-not (predicate list start end from-end count remove-empty-subseqs key)
+  (split-list-if (complement predicate) list start end from-end count remove-empty-subseqs key))
+
+(defun split-list
+    (delimiter list start end from-end count remove-empty-subseqs test test-not key)
+  (let ((predicate (if test-not
+                       (lambda (x) (not (funcall test-not delimiter (funcall key x))))
+                       (lambda (x) (funcall test delimiter (funcall key x))))))
+    (if from-end
+        (split-list-from-end predicate list start end count remove-empty-subseqs)
+        (split-list-from-start predicate list start end count remove-empty-subseqs))))