[cl-utilities-devel] split-sequence performance problem.

[Szymon]

Yesterday I posted buggy code, below there is new wersion.
I hope it's both fast and memory economical (it don't
do unnecesary consing with :FROM-END & :COUNT).


(defun split-list-if (test list
                      &key preserve-delimiters key count from-end
                      &aux (test-not (complement test)))
  (when (or (null list) (and count (zerop count)))
    (return-from split-list-if))
  (when (and from-end (not count))
    (setq from-end nil))
  (let* ((member
          (lambda (list test copy?)
            (do ((i list (cdr i))
                 (r '() (when copy? (cons (car i) r))))
                ((or (endp i)
                     (funcall test (if key
                                       (funcall key (car i))
                                     (car i))))
                 (values i (when copy?
                             (if from-end
                                 (when list (cons list i))
                               (nreverse r))))))))
         (get-next
          (if preserve-delimiters
              (let ((%test test))
                (lambda ()
                  (multiple-value-bind (rest result)
                      (funcall member list %test t)
                    (setq %test
                          (if (eq %test test) test-not test))
                    (setq list rest)
                    result)))
            (lambda ()
              (multiple-value-bind (rest result)
                  (funcall member list test t)
                (when (setq list rest)
                  (setq list (funcall member list test-not nil)))
                result)))))
    (let (result pointer next init-delims)
      (setq init-delims
            (let ((tail (member-if-not test list :key key)))
              (cond ((and (null tail) (cdr list))
                     (prog1 (copy-list list) (setq list nil)))
                    (t
                     (prog1 (ldiff list tail) (setq list tail))))))
      (if preserve-delimiters
          (when (and init-delims
                     (or (and (not from-end) count (= count 1))
                         (null list)))
            (return-from split-list-if (list init-delims)))
        (unless list (return-from split-list-if)))
      (setq result (list (if (and preserve-delimiters init-delims)
                             (if from-end
                                 (cons init-delims list)
                               init-delims)
                           (funcall get-next)))
            pointer result)
      (if count
          (loop repeat (1- count)
                while (setq next (funcall get-next))
                do (setq pointer (cdr (rplacd pointer (list next)))))
        (loop while (setq next (funcall get-next))
              do (setq pointer (cdr (rplacd pointer (list next))))))
      (when (and count from-end)
        (when list
          (cond ((= count 1)
                 (loop for x = (funcall get-next) do (if x (setq next x) (return)))
                 (setq result (rplaca result next)))
                (t (loop while (setq next (funcall get-next))
                         for cell = (prog1 result (setq result (cdr result)))
                         do (rplaca (setq pointer (cdr (rplacd pointer cell))) next))
                   (rplacd pointer nil))))
        (map-into result (lambda (cons) (ldiff (car cons) (cdr cons))) result))
      result)))

Regards, Szymon.