Skip to content

Instantly share code, notes, and snippets.

@sjl sjl/list.lisp
Last active Dec 24, 2018

Embed
What would you like to do?
;;;; -*- 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))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.