There are several features of Lisp that I find very useful, and miss when I’m working in, for example, C++. One in particular is the ability to create new flow-control syntaxes.

To draw from a real example from my work, let’s say I have an arbitrary closed polygon, defined as an ordered sequence of points, and I’m interested in performing operations on these points, either individually, pairwise, or in triplets. I also might want to go in forward or reverse directions.

I’ll represent my polygons as doubly-linked lists. Not circular, it will be up to the user of the data structure to wrap around, if necessary, upon reaching the end of the list.

I’m going to be developing and refining this code, starting simply, but moving on to doing things better. Here’s our first iteration of a doubly-linked list, with a few helper functions.

Work will continue in a later post.

;; 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-push-front (dl-list val)
  "Push a value onto the front of the list."
  (let* ((first-node (dl-list-first-node dl-list))
         (new-node (make-dl-node :value val
                                :next-node first-node
                                :prev-node nil)))
    (when first-node
      (setf (dl-node-prev-node first-node) new-node))

    (setf (dl-list-first-node dl-list) new-node)
    (unless (dl-list-last-node dl-list)
      (setf (dl-list-last-node dl-list) new-node))
    new-node))

(defun dl-list-push-back (dl-list val)
  "Push a value onto the back of the list."
  (let* ((last-node (dl-list-last-node dl-list))
         (new-node (make-dl-node :value val
                                :next-node nil
                                :prev-node last-node)))
    (when last-node
      (setf (dl-node-next-node last-node) new-node))

    (setf (dl-list-last-node dl-list) new-node)
    (unless (dl-list-first-node dl-list)
      (setf (dl-list-first-node dl-list) new-node))
    new-node))

(defun dl-list-pop-front (dl-list)
  "Remove the first value from the list and return it.  Returns nil if the list is empty."
  (when (dl-list-first-node dl-list)
    (let* ((first-node (dl-list-first-node dl-list))
           (second-node (dl-node-next-node first-node))
           (rv (dl-node-value first-node)))
      (cond
        (second-node
         (setf (dl-node-prev-node second-node) nil)
         (setf (dl-list-first-node dl-list) second-node))
        (t
         (setf (dl-list-first-node dl-list) nil
               (dl-list-last-node dl-list) nil)))
      rv)))

(defun dl-list-pop-back (dl-list)
  "Remove the last value from the list and return it.  Returns nil if the list is empty."
  (when (dl-list-last-node dl-list)
    (let* ((last-node (dl-list-last-node dl-list))
           (penultimate-node (dl-node-prev-node last-node))
           (rv (dl-node-value last-node)))
      (cond
        (penultimate-node
         (setf (dl-node-next-node penultimate-node) nil)
         (setf (dl-list-last-node dl-list) penultimate-node))
        (t
         (setf (dl-list-first-node dl-list) nil
               (dl-list-last-node dl-list) nil)))
      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-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."
  (let* ((next-node (dl-node-next-node iter))
         (new-node (make-dl-node :value val 
                                 :next-node next-node
                                 :prev-node iter)))
    (cond
      (next-node
       (setf (dl-node-prev-node next-node) new-node))
      (t
       (setf (dl-list-last-node dl-list) new-node)))
    (setf (dl-node-next-node iter) new-node)
    new-node))

(defun dl-list-insert-before-iter (dl-list iter val)
  "Insert a value into the list before the position of the iterator."
  (let* ((prev-node (dl-node-prev-node iter))
         (new-node (make-dl-node :value val 
                                 :next-node iter
                                 :prev-node prev-node)))
    (cond
      (prev-node
       (setf (dl-node-next-node prev-node) new-node))
      (t
       (setf (dl-list-first-node dl-list) new-node)))
    (setf (dl-node-prev-node iter) new-node)
    new-node))

(defun unit-test ()
  (let ((test-list (make-dl-list)))
    (assert (dl-list-empty-p test-list))
    (dl-list-push-front test-list 10)
    (assert (not (dl-list-empty-p test-list)))
    (assert (= (dl-list-length test-list) 1))
    (dl-list-push-front test-list 5)
    (assert (not (dl-list-empty-p test-list)))
    (assert (= (dl-list-length test-list) 2))
    (dl-list-push-back test-list 20)
    (assert (not (dl-list-empty-p test-list)))
    (assert (= (dl-list-length test-list) 3))
    (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)
      (assert (not (dl-list-empty-p test-list)))
      (assert (= (dl-list-length test-list) 4))

      (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)
      (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)))))