Having written a somewhat basic and brute-force version of the doubly-linked list code in the previous post, I’m going to start cleaning it up.  This first change is fairly small.  Collection of common code, and an improved unit test.

One helpful shortcut in lisp is the ability to build lists at function invocation time, with the &rest keyword.  That’s just a bit of syntactic convenience, it can easily be implemented with the (list) function, but it’s worth pointing out.  In C/C++, I’d have to use some repetitive boilerplate for this, either building up C arrays, or filling in C++ vectors.  Not really a big deal, though.  The real magic will come later.  Continued in part 3.

;; We started with a fairly basic version.  It worked, but was clunky.
;; Now, we start making changes.

(declaim (optimize (debug 3) (safety 3)))

;; Define the node.  They're opaque types to the user, but they double
;; as iterators (also opaque).
(defstruct (dl-node)
  (value        nil)
  (next-node    nil)
  (prev-node    nil))

;; Define the doubly-linked list.
(defstruct (dl-list)
  (first-node   nil)
  (last-node    nil))

(defun dl-list-empty-p (dl-list)
  "Returns non-nil if the list is empty."
  (not (dl-list-first-node dl-list)))

(defun dl-list-length (dl-list)
  (let ((rv 0))
    (do ((iter (dl-list-iter-front dl-list) (dl-list-iter-next dl-list iter)))
        ((not iter) rv)
      (incf rv))))

(defun dl-list-iter-front (dl-list)
  "An iterator to the first element in the list."
  (dl-list-first-node dl-list))

(defun dl-list-iter-back (dl-list)
  "An iterator to the last element in the list."
  (dl-list-last-node dl-list))

(defun dl-list-iter-next (dl-list iter)
  "The next iterator, or nil if we're at the end of the list."
  (declare (ignore dl-list))
  (dl-node-next-node iter))

(defun dl-list-iter-prev (dl-list iter)
  "The previous iterator, or nil if we're at the beginning of the list."
  (declare (ignore dl-list))
  (dl-node-prev-node iter))

(defun dl-list-insert-after-worker (dl-list iter val)
  "Insert a value in the dl-list after the iterator.  As a special case, 
if 'iter' is nil, inserts at the front of the list."

  (let* ((next-node (if iter (dl-node-next-node iter) (dl-list-first-node dl-list)))
         (prev-node iter)
         (new-node (make-dl-node :value val
                                 :next-node next-node
                                 :prev-node prev-node)))
    (cond
      (next-node
       (setf (dl-node-prev-node next-node) new-node))
      (t
       (setf (dl-list-last-node dl-list) new-node)))
    (cond
      (prev-node
       (setf (dl-node-next-node prev-node) new-node))
      (t
       (setf (dl-list-first-node dl-list) new-node)))

    new-node))

(defun dl-list-delete-at-worker (dl-list iter)
  "Deletes the value under the iterator."
  (assert iter)
  (let ((prev-node (dl-node-prev-node iter))
        (next-node (dl-node-next-node iter)))
    (cond
      (prev-node
       (setf (dl-node-next-node prev-node) next-node))
      (t
       (setf (dl-list-first-node dl-list) next-node)))

    (cond
      (next-node
       (setf (dl-node-prev-node next-node) prev-node))
      (t
       (setf (dl-list-last-node dl-list) prev-node))))

  (dl-node-value iter))

(defun dl-list-push-front (dl-list val)
  "Push a value onto the front of the list."
  (dl-list-insert-after-worker dl-list nil val))

(defun dl-list-push-back (dl-list val)
  "Push a value onto the back of the list."
  (dl-list-insert-after-worker dl-list (dl-list-last-node dl-list) val))

(defun dl-list-pop-front (dl-list)
  "Remove the first value from the list and return it.  Returns nil if the list is empty."
  (let ((first-iter (dl-list-iter-front dl-list)))
    (when first-iter
      (dl-list-delete-at-worker dl-list first-iter))))

(defun dl-list-pop-back (dl-list)
  "Remove the last value from the list and return it.  Returns nil if the list is empty."
  (let ((last-iter (dl-list-iter-back dl-list)))
    (when last-iter
      (dl-list-delete-at-worker dl-list last-iter))))

(defun dl-list-iter-contents (dl-list iter)
  "The value of the list element pointed to by the iterator."
  (declare (ignore dl-list))
  (dl-node-value iter))

(defun dl-list-insert-after-iter (dl-list iter val)
  "Insert a value into the list after the position of the iterator."
  (assert iter)
  (dl-list-insert-after-worker dl-list iter val))

(defun dl-list-insert-before-iter (dl-list iter val)
  "Insert a value into the list before the position of the iterator."
  (assert iter)
  (dl-list-insert-after-worker dl-list (dl-list-iter-prev dl-list iter) val))

(defun verify-dl-list-contents (dl-list &rest contents)
  (assert (= (dl-list-length dl-list) (length contents)))
  (assert (or (and contents (not (dl-list-empty-p dl-list)))
              (and (not contents) (dl-list-empty-p dl-list))))
  (let ((iter (dl-list-iter-front dl-list)))
    (dolist (entry contents)
      (assert (eq entry (dl-list-iter-contents dl-list iter)))
      (setf iter (dl-list-iter-next dl-list iter)))))

(defun unit-test ()
  (let ((test-list (make-dl-list)))

    (verify-dl-list-contents test-list)

    (dl-list-push-front test-list 10)
    (verify-dl-list-contents test-list 10)

    (dl-list-push-front test-list 5)
    (verify-dl-list-contents test-list 5 10)

    (dl-list-push-back test-list 20)
    (verify-dl-list-contents test-list 5 10 20)

    (let ((iter (dl-list-iter-front test-list)))
      (assert (= (dl-list-iter-contents test-list iter) 5))
      (dl-list-insert-after-iter test-list iter 7)

      (verify-dl-list-contents test-list 5 7 10 20)

      (setf iter (dl-list-iter-next test-list iter))
      (assert (= (dl-list-iter-contents test-list iter) 7))

      (dl-list-insert-before-iter test-list iter 6)

      (verify-dl-list-contents test-list 5 6 7 10 20)

      (setf iter (dl-list-iter-prev test-list iter))
      (assert (= (dl-list-iter-contents test-list iter) 6))

      (setf iter (dl-list-iter-next test-list iter))
      (assert iter)
      (assert (= (dl-list-iter-contents test-list iter) 7))

      (setf iter (dl-list-iter-next test-list iter))
      (assert iter)
      (assert (= (dl-list-iter-contents test-list iter) 10))

      (setf iter (dl-list-iter-next test-list iter))
      (assert iter)
      (assert (= (dl-list-iter-contents test-list iter) 20))

      (setf iter (dl-list-iter-next test-list iter))
      (assert (not iter)))

    (assert (= (dl-list-iter-contents test-list (dl-list-iter-front test-list)) 5))
    (assert (= (dl-list-iter-contents test-list (dl-list-iter-back test-list)) 20))

    (assert (= (dl-list-pop-front test-list) 5))
    (assert (= (dl-list-length test-list) 4))
    (assert (= (dl-list-iter-contents test-list (dl-list-iter-front test-list)) 6))

    (assert (= (dl-list-pop-back test-list) 20))
    (assert (= (dl-list-length test-list) 3))
    (assert (= (dl-list-iter-contents test-list (dl-list-iter-back test-list)) 10)))
  t)

(defmethod print-object ((node dl-node) stream)
  "Allow pretty-printing of the a node."
  (let ((prev-node (dl-node-prev-node node))
        (next-node (dl-node-next-node node)))
    (format stream "{ ~A <- ~A -> ~A }" 
            (and prev-node (dl-node-value prev-node))
            (dl-node-value node)
            (and next-node (dl-node-value next-node)))))