Plaster
New
List
Login
common-lisp
default
anonymous
2018.12.22 22:21:03
(defun split-list-internal (predicate list start end count remove-empty-subseqs key) (declare (optimize (speed 3) (debug 0))) (let ((current-first nil) (current-last nil) (next-cons (nthcdr start list)) (result '()) (nr-elts 0)) (declare (unsigned-byte nr-elts)) (do ((n start (1+ n))) (nil) (declare (unsigned-byte n)) (cond ((or (endp next-cons) (and count (>= nr-elts count)) (<= end n)) (unless (or (and count (>= nr-elts count)) (and remove-empty-subseqs (null current-first))) (push current-first result)) (when (and (= end n) current-first) (setf (cdr current-last) nil)) (when (and remove-empty-subseqs (< n end)) (loop :while next-cons :while (< n end) :while (funcall predicate (funcall key (car next-cons))) :do (setf next-cons (cdr next-cons)) (incf n))) (return (values (nreverse result) n))) ((funcall predicate (funcall key (car next-cons))) (unless (and remove-empty-subseqs (null current-first)) (push current-first result) (incf nr-elts)) (when current-last (setf (cdr current-last) nil)) (setf next-cons (cdr next-cons) current-first nil current-last nil)) (t (setf current-last next-cons) (unless current-first (setf current-first next-cons)) (setf next-cons (cdr next-cons)))))))
Raw
Annotate
Repaste
Edit