ruricolist / serapeum

Utilities beyond Alexandria
MIT License
420 stars 41 forks source link

Maybe add SPLICE and SPLICEF #117

Closed phoe closed 2 years ago

phoe commented 2 years ago

Common Lisp Recipes mentions a function called splice which can be used to destructively install elements of one list into another (for as long as its value is not discarded):

(defun splice (list &key (start 0) (end (length list)) new)
  (setf list (cons nil list))
  (let ((reroute-start (nthcdr start list)))
    (setf (cdr reroute-start)
          (nconc (make-list (length new))
                 (nthcdr (- end start)
                         (cdr reroute-start)))
          list (cdr list)))
  (replace list new :start1 start)
  list)

Here is its example usage:

CL-USER> (defparameter *list* (list 'a 'b 'c 'd 'e))
*LIST*
CL-USER> (defparameter *new* (list 'x 'y 'z))
*NEW*
CL-USER> (setf *list* (splice *list* :start 1 :end 3 :new *new*))
(A X Y Z D E)
CL-USER> *new*
(X Y Z)
CL-USER> (splice *list* :start 1 :end 4)
(A D E)
CL-USER> (splice *list* :start 2 :new (list 1 2 3))
(A D 1 2 3)
CL-USER> (splice *list* :start 3 :end 3 :new (list 42))
(A D 1 42 2 3)
CL-USER> *list*
(A D 1 42 2 3)

Is there an equivalent in Serapeum? (A brief scan of the API page did not show anything.) If not, would it be welcome to generalize this function to all sequences rather than just lists, and add it to Serapeum along with a splicef modify macro?

One possibility is adding a possible nsplice and nsplicef for destructive operation on its new argument, but it might be overkill - another option is to add a :destroy-new-list-p keyword that, if true, nconcs the new list rather than copying its values.

phoe commented 2 years ago

Another idea is to provide splice and splicef that are not destructive (as in, they mutate neither the target nor the source sequence) and have nsplice and nsplicef that are allowed to destroy both sequences. splice can be implemented in terms of nsplice over two copy-seq. The user can then choose which parts they'd like to keep by an explicit copy-seq over nsplice, or have a pure functional interface via splice.

phoe commented 2 years ago

Example implementation, not yet properly tested. Modify macros not included.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Lists

(declaim (inline copy-enough-list nsplice-list splice-list))

(defun copy-enough-list (list n)
  (declare (optimize speed))
  (declare (type list list))
  (declare (type fixnum n))
  (loop for i upto n
        for x on list
        if (< i n) collect (car x) else nconc x))

(defun nsplice-list (list new start end)
  (declare (optimize speed))
  (declare (type list list))
  (declare (type (or null list) new))
  (declare (type alexandria:array-index start end))
  (let* ((temp-list (cons nil list))
         (cut-start (nthcdr start temp-list))
         (cut-end (nthcdr (- end start) (cdr cut-start))))
    (if (null new)
        (setf (cdr cut-start) cut-end)
        (setf (cdr cut-start) new
              (cdr (last new)) cut-end))
    (cdr temp-list)))

(defun splice-list (list new start end)
  (declare (optimize speed))
  (declare (type list list))
  (declare (type (or null list) new))
  (declare (type alexandria:array-index start end))
  (nsplice-list (copy-enough-list list start) (copy-list new) start end))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Vectors

(declaim (inline nsplice-vector splice-vector))

(deftype array-size-difference ()
  `(integer ,(- array-dimension-limit) ,array-dimension-limit))

(defun nsplice-vector (vector new start end)
  (declare (type alexandria:array-index start end))
  (declare (type vector vector))
  (declare (type (or vector null) new))
  (let ((diff-removed (- end start))
        (diff-added (length new)))
    (if (= diff-removed diff-added)
        (replace vector new :start1 start)
        (let* ((diff (- diff-added diff-removed))
               (length (length vector))
               (new-end (+ end diff))
               (new-length (+ length diff)))
          (declare (type array-size-difference diff))
          (declare (type alexandria:array-index new-end))
          (declare (type alexandria:array-length new-length))
          (cond ((typep vector 'simple-array)
                 (let ((result (make-array new-length :element-type
                                           (array-element-type vector))))
                   (replace result result :start1 new-end :end1 new-length
                                          :start2 end :end2 length)
                   (when new
                     (replace result new :start1 start :end1 end))
                   result))
                (t
                 (let ((result (adjust-array vector new-length)))
                   (replace result result :start1 new-end :end1 new-length
                                          :start2 end :end2 length)
                   (when new
                     (replace result new :start1 start :end1 end))
                   result)))))))

(defun splice-vector (vector new start end)
  (declare (type vector vector new))
  (declare (type alexandria:array-index start end))
  (nsplice-vector (copy-seq vector) new start end))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; API

(declaim (ftype (function (sequence &key
                                    (:new sequence)
                                    (:start alexandria:array-index)
                                    (:end alexandria:array-index))
                          (values sequence &optional))
                splice nsplice))

(declaim (inline splice nsplice))

(defun splice (sequence &key new (start 0) (end (length sequence)))
  (declare (type sequence sequence new))
  (typecase sequence
    (list (check-type new list))
    (vector (check-type new (or null vector))))
  (if (and (= start end) (= 0 (length new)))
      sequence
      (etypecase sequence
        (list (splice-list sequence new start end))
        (vector (splice-vector sequence new start end)))))

(defun nsplice (sequence &key new (start 0) (end (length sequence)))
  (declare (type sequence sequence new))
  (typecase sequence
    (list (check-type new list))
    (vector (check-type new (or null vector))))
  (if (and (= start end) (= 0 (length new)))
      sequence
      (etypecase sequence
        (list (nsplice-list sequence new start end))
        (vector (nsplice-vector sequence new start end)))))