list.lisp

;;;; -*- 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.

  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)
                                          (= 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.

  "
  (loop :for value :in list
        :for i :below end
        :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 (- end start))
        (list (nthcdr start list)))
    (flet ((should-collect-p (chunk)
             (unless (and remove-empty-subseqs (null chunk))
               (when count (decf count))
               t))
           (gather-chunk ()
             (multiple-value-bind (chunk remaining examined ran-off-end)
                 (collect-until predicate list end)
               (incf index examined)
               (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)
                             (- length end) (- 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))))