Here we are continuing from part 2.

The reader might be remaking by now that we’re cluttering up the namespace with these functions, and it’s a bit inelegant to make all the function names start with dl-list-.  Also, some of the functions there are for internal use, while others are parts of the interface.  A modern language should address these problems.

So, enter the package.  Think of this as a C++ namespace, not a class name.  The exported names, i.e. the external API, are listed in the declaration of the package.  At a glance, the user can tell which functions are expected to be used outside the package.  Now, we can drop the dl-list- prefix on our functions, and that becomes the namespace.  Functions would now be invoked as (dl-list:make-dl-list).  If the user absolutely needs access to the internal functions, though, it is possible to call them, by using a double-colon separator between the namespace and the function name.  This is different from the C++ convention of private and public methods, and allows the programmer to make use of the “private” functions without having to modify the source code of the package.  In C++, the programmer would have to add a friend declaration to the class definition, which requires modifying the class.

We’ve also modified the automatically-generated functions in the definition of the dl-list structure.  Having the structure interface functions be prefixed dl-list is now a bit confusing given the namespace behaviour, so we use the :conc-name parameter to modify the way those functions are defined.

We’re almost ready to start in on the more interesting features.  Those will come in part 4.

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

(defpackage :DL-LIST
  (:use :COMMON-LISP)
  (:export :EMPTY-P :DL-LENGTH :ITER-FRONT :ITER-BACK :ITER-NEXT :ITER-PREV
           :PUSH-FRONT :PUSH-BACK :POP-FRONT :POP-BACK :ITER-CONTENTS
           :INSERT-AFTER-ITER :MAKE-DL-LIST))

(in-package :DL-LIST)

(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 (:conc-name dlst-))
  (first-node   nil)
  (last-node    nil))

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

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

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

(defun 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 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-length (dl-list)
  (let ((rv 0))
    (do ((iter (iter-front dl-list) (iter-next dl-list iter)))
        ((not iter) rv)
      (incf rv))))

(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) (dlst-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 (dlst-last-node dl-list) new-node)))
    (cond
      (prev-node
       (setf (dl-node-next-node prev-node) new-node))
      (t
       (setf (dlst-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 (dlst-first-node dl-list) next-node)))

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

  (dl-node-value iter))

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

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

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

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

(defun 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 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 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 (iter-prev dl-list iter) val))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    (assert (= (pop-back test-list) 20))
    (assert (= (dl-length test-list) 3))
    (assert (= (iter-contents test-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)))))