Writing Destructive Functions

[Peter Benson <pab%glen-canyon-dam@lucid.com>]

I would recomend that you NOT use code like this, but here it is.
It is possible to reuse the cells in items so it does no consing.

;;; Personally I would never use code like this because you can shoot
;;; yourself in the foot so easily.
;;;
;;; It squirrels away the first cell of list,
;;; conses the original first item in list onto the original rest.
;;; It pushes the all new items except the last onto the result.
;;; The new first item in the list is put int the car of the original first
;;; cell in list, and the accumulated list is put in the cdr of the
;;; original first cell.
;;; et voila.
(defun destructively-reverse-items-to-front (items list)
  ;; it reverses items because the code happens to be simpler that way.
  (let* ((first-cell list)
         (first-item (car first-cell))
         (rest (cons first-item (rest list))))
    (do ((tail items (cdr tail)))
        ((null (cdr tail))
         (if (null tail) ; no items
             list
             (setf (car first-cell) (car tail)
                   (cdr first-cell) rest)))
      (push (car tail) rest)))
  list)


> (setq list '(1 2 3 4 5))
(1 2 3 4 5)
> (DESTRUCTIVELY-REVERSE-ITEMS-TO-FRONT '(a b c d e) list)
(E D C B A 1 2 3 4 5)
> list
(E D C B A 1 2 3 4 5)

;;;; here's the nonconsing nonreversing version

(defun nitems-to-front (items list)
    (let* ((first-cell list)
	   (old-first (car list))
	   (new-first (car items))
	   (first-item-cell items)
	   (original-rest (rest list))
	   (last-items (last items))
	   )
      (setf (car first-cell) new-first)
      (setf (cdr first-cell) (rest items))
      (setf (car first-item-cell) old-first)
      (setf (cdr first-item-cell) original-rest)
      (setf (cdr last-items) first-item-cell)
      first-cell))