Last active
December 24, 2018 04:08
Revisions
-
sjl revised this gist
Dec 24, 2018 . 1 changed file with 18 additions and 13 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal file line number Diff line number Diff line change @@ -2,7 +2,9 @@ (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)) @@ -55,16 +57,15 @@ :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) @@ -73,12 +74,16 @@ (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))) @@ -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 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))))) -
sjl revised this gist
Dec 24, 2018 . 1 changed file with 1 addition and 14 deletions.There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal 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. " (let ((examined 0) @@ -81,18 +80,6 @@ (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) -
sjl created this gist
Dec 24, 2018 .There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters. Learn more about bidirectional Unicode charactersOriginal 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))))