Skip to content

Instantly share code, notes, and snippets.

@sjl
Last active December 24, 2018 04:08

Revisions

  1. sjl revised this gist Dec 24, 2018. 1 changed file with 18 additions and 13 deletions.
    31 changes: 18 additions & 13 deletions list.lisp
    Original file line number Diff line number Diff line change
    @@ -2,7 +2,9 @@

    (in-package :split-sequence)

    (declaim (notinline
    (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))

    @@ -55,16 +57,15 @@
    :summing 1))

    (defun split-list-internal (predicate list start end count remove-empty-subseqs)
    (let ((result '())
    (count count)
    (let ((count count)
    (done nil)
    (index start)
    (end (- end start))
    (list (nthcdr start list)))
    (flet ((push-chunk (chunk)
    (flet ((should-collect-p (chunk)
    (unless (and remove-empty-subseqs (null chunk))
    (push chunk result)
    (when count (decf count))))
    (when count (decf count))
    t))
    (gather-chunk ()
    (multiple-value-bind (chunk remaining examined ran-off-end)
    (collect-until predicate list end)
    @@ -73,12 +74,16 @@
    (setf list remaining
    done ran-off-end)
    chunk)))
    (loop :until (or done (eql 0 count))
    :do (push-chunk (gather-chunk))))
    (values (nreverse result)
    (+ index (if remove-empty-subseqs
    (count-while predicate list end) ; chew off remaining empty seqs
    0)))))
    (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)))
    @@ -91,7 +96,7 @@
    (values (nreverse result) (- length index)))))

    (defun split-list-from-start (predicate list start end count remove-empty-subseqs)
    (split-list-internal predicate (copy-list 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)))))
  2. sjl revised this gist Dec 24, 2018. 1 changed file with 1 addition and 14 deletions.
    15 changes: 1 addition & 14 deletions list.lisp
    Original file line number Diff line number Diff line change
    @@ -25,8 +25,7 @@
    * 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.
    * Whether the search ended by running off the end, instead of by finding a delimiter.
    "
    (let ((examined 0)
    @@ -81,18 +80,6 @@
    (count-while predicate list end) ; chew off remaining empty seqs
    0)))))


    (defun split (d vec &rest args)
    (flet ((l (vec)
    (coerce vec 'list))
    (v (lis)
    (coerce lis 'string)))
    (multiple-value-bind (refv refi) (apply #'split-sequence d vec args)
    (multiple-value-bind (newl newi) (apply #'split-sequence d (l vec) args)
    (terpri)
    (format t "REF: ~S~% ~D~%" refv refi)
    (format t "NEW: ~S~% ~D~%" (mapcar #'v newl) newi)))))

    (defun split-list-from-end (predicate list start end count remove-empty-subseqs)
    (let ((length (length list)))
    (multiple-value-bind (result index)
  3. sjl created this gist Dec 24, 2018.
    125 changes: 125 additions & 0 deletions list.lisp
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,125 @@
    ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-

    (in-package :split-sequence)

    (declaim (notinline
    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 ((result '())
    (count count)
    (done nil)
    (index start)
    (end (- end start))
    (list (nthcdr start list)))
    (flet ((push-chunk (chunk)
    (unless (and remove-empty-subseqs (null chunk))
    (push chunk result)
    (when count (decf count))))
    (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)))
    (loop :until (or done (eql 0 count))
    :do (push-chunk (gather-chunk))))
    (values (nreverse result)
    (+ index (if remove-empty-subseqs
    (count-while predicate list end) ; chew off remaining empty seqs
    0)))))


    (defun split (d vec &rest args)
    (flet ((l (vec)
    (coerce vec 'list))
    (v (lis)
    (coerce lis 'string)))
    (multiple-value-bind (refv refi) (apply #'split-sequence d vec args)
    (multiple-value-bind (newl newi) (apply #'split-sequence d (l vec) args)
    (terpri)
    (format t "REF: ~S~% ~D~%" refv refi)
    (format t "NEW: ~S~% ~D~%" (mapcar #'v newl) newi)))))

    (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 (copy-list 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))))