I implemented a basic binary heap in Common-Lisp to learn programming using the CLOS. It is quite neat and self-contained, the core of the program is about 100 SLOC. The whole repository can be found here: https://github.com/thomashoullier/cl-binheap. A binary heap is this: https://en.wikipedia.org/wiki/Binary_heap.

The crux of the program is binheap.lisp:

;;;; Binary heap implementation.
;;;; We implemented this structure using the excellent article at:
;;;; https://en.wikipedia.org/wiki/Binary_heap
;;;; The binary heap is implemented as a CLOS class.
;;;; Please note that the vector you provide to the heap object is used in-place
;;;; throughout the life of the heap. It is up to you to make copies and ensure
;;;; the vector is not modified externally.

(in-package :binhp)

(defclass heap ()
  ((vec
    :documentation "Resizeable array to store the implicit Binary Heap."
    :initarg :vec
    :initform (error "class heap: Please provide a vector")
    :accessor vec)
   (test
    :documentation "Total order function. The heap enforces:
{funcall totorder parent child} throughout the binary tree."
    :initarg :test
    :initform (error "class heap: Please provide a total order relation.")
    :accessor test)))

(defun make-heap (vec test)
  "Heap constructor.
I: vec: Vector to back the implicit binary tree structure. Works in place.
        Must have a fill-pointer.
   test: The total order to enforce throughout the heap. 
         [funcall test parent child] is true throughout the tree."
  (assert (array-has-fill-pointer-p vec))
  (assert (typep test 'function))
  (let ((hp (make-instance 'heap :vec vec :test test))) 
    (build hp)
    hp))

;;; Main
(defmethod build ((tree heap))
  "Initial building of the binary heap from the input vector of data.
Sub-method."
  ;; We work our way up the tree calling the down-heap method on each parent
  ;; node.
  ;; Parent nodes are the ones from 0 to floor{n-2 / 2} included.
  (loop for ind from (floor (/ (- (length (vec tree)) 2) 2)) downto 0 do
        (down-heap tree ind)))

(defmethod insert ((tree heap) newkey)
  "Push a new element to the heap.
I: * Heap instance.
   * New element."
  (with-slots ((arr vec)
               (test test)) tree
    ;; Inserts a new element at the end of arr and performs a up-heap.
    ;; Last element of the array is guaranteed to be a leaf of the tree.
    (vector-push-extend newkey arr)
    ;; Compare the new element with its parent node.
    ;;   * If order is respected or if we've reached the root of the tree
    ;;     then return.
    ;;   * Else swap. And repeat.
    (let* ((ind (1- (length arr)))
           (parind (floor (/ (1- ind) 2))))
      (loop while (and (not (= ind 0))
                       (not (funcall test (aref arr parind)
                                     (aref arr ind)))) do
            (rotatef (aref arr parind) (aref arr ind))
            (setf ind parind)
            (setf parind (floor (/ (1- ind) 2)))))))

(defmethod down-heap ((tree heap) ind)
  "Perform the down-heap operation. Move the parent node at 'ind' downwards
until it settles in a suitable position. Sub-method, not exposed to user."
  ;; Compare the current key with its two children. Return if order is respected
  ;; else swap the current key with the child that respects the total order with
  ;; the other child. Also return if we have reached a leaf of the tree.
  ;; Nodes at an index starting at ceil{n-2 / 2} are leafs.
  (with-slots ((arr vec)
               (test test)) tree
    (let* ((maxind (1- (length arr)))
           (leaf-limit (floor (/ (1- maxind) 2)))
           (left-child (+ (* 2 ind) 1))
           (right-child (min (1+ left-child) maxind)))
      (loop while
            (and
             ;; Order of tests matters here!
             (not (> ind leaf-limit))
             (not (and (funcall test (aref arr ind) (aref arr left-child))
                       (funcall test (aref arr ind) (aref arr right-child)))))
            do
            ;; Find out the right child to swap with and swap.
            (if (funcall test (aref arr left-child) (aref arr right-child))
                (progn (rotatef (aref arr ind) (aref arr left-child))
                       (setf ind left-child))
                (progn (rotatef (aref arr ind) (aref arr right-child))
                       (setf ind right-child)))
            (setf left-child (+ (* 2 ind) 1))
            (setf right-child (min (1+ left-child) maxind))))))

(defmethod extract ((tree heap))
  "Pop the root element from the heap. Rearranges the tree afterwards.
I: Heap instance.
O: Root element."
  (with-slots ((arr vec)) tree
    (let ((root (aref arr 0)))
      ;; replace the root with the last leaf
      ;; resize vector
      ;; down-heap the new root.
      (setf (aref arr 0) (aref arr (1- (length arr))))
      (vector-pop arr)
      (down-heap tree 0)
      root)))

(defmethod print-tree ((tree heap))
  "Print the whole tree in a very basic formatting, level by level 
and left to right."
  (with-slots ((arr vec)) tree
    (let* ((n (length arr))
           (h (floor (log n 2))))
      ;; The heap is already ordered by level. And each level is in the right
      ;; order.
      (loop for level from 0 upto h do
            (loop for ind from (1- (expt 2 level))
                  below (1- (expt 2 (1+ level))) do
                  (if (< ind n)
                      (format t "~a " (aref arr ind))))
            (terpri t)))))

(defmethod size ((tree heap))
(length (vec tree)))

And you can see some examples in example.lisp:

;;;; Examples illustrating the use of the binary heap implementation.

;;; Loading the library, adjust the paths to your own directories.
;;; Can also be done by loading the source files directly.
(if (not (member #p"~/portacle/projects/"
                 asdf:*central-registry*))
    (push #p"~/portacle/projects/"
          asdf:*central-registry*))
(ql:quickload :binheap)
;;; Max-heaps
;; Let's build a heap of integers ordered from biggest to smallest.
(defparameter *arr* (make-array 6 :fill-pointer 6
                          :initial-contents (list 3 4 1 2 5 6)))
(defparameter *heap* (binhp:make-heap *arr* #'>=))
;; #'>= is the relation enforced throughout the heap between every parent node
;; and its children.
(binhp:print-tree *heap*)
;; =>
;; 6 
;; 5 3 
;; 2 4 1
;; Alright, this is a nice heap.
;; You can insert elements in it:
(binhp:insert *heap* 3.5)
(binhp:print-tree *heap*)
;; =>
;; 6 
;; 5 3.5 
;; 2 4 1 3
;; The new element fits in the heap.
;; You can pop elements to get the successive biggest of the heap:
(loop for it from 0 below (length *arr*) do
      (format t "~a " (binhp:extract *heap*)))
(terpri t)
;; => 6 5 4 3.5 3 2 1
;;; The same goes for Min-heaps, just replace #'>= with #'<=.
;;; You can define any relation that is a total order in 'test.
;;; Alphabetical heap.
;; The heap implementation works for any element types and any total order.
;; Let's put some strings in an alphabetical order heap.
(defparameter *arr*
  (make-array 5
              :fill-pointer 5
              :initial-contents (list "Pierre" "Jacques" "Paul" "Jean" "Luc")))
(defparameter *heap* (binhp:make-heap *arr* #'string-lessp))
(binhp:print-tree *heap*)
;; =>
;; Jacques 
;; Jean Paul 
;; Pierre Luc
(loop for it from 0 below (length *arr*) do
      (format t "~a " (binhp:extract *heap*)))
(terpri t)
;; => Jacques Jean Luc Paul Pierre

As well as some tests in test.lisp:

;;;; Simple tests for validating binheap.

;;; Loading the library, adjust the paths to your own directories.
(if (not (member #p"~/portacle/projects/"
                 asdf:*central-registry*))
    (push #p"~/portacle/projects/"
          asdf:*central-registry*))
(ql:quickload :binheap)
;;; Validation
(format t "Creating empty or small binary heaps:...")
(dotimes (it 10 t)
  (let ((arr (make-array it :fill-pointer it)))
    (binhp:make-heap arr #'>=)))
(format t " OK") (terpri t)
(format t "Simple heaps and operations:...")
(loop for test in (list #'>= #'<=) do
      (loop for nelem from 10 upto 50 do
            (let ((arr (make-array nelem :fill-pointer nelem))
                  (arrval (make-array nelem))
                  (hp nil))
              (loop for ind from 0 below nelem do
                    (setf (aref arr ind) (random 100))
                    (setf (aref arrval ind) (aref arr ind)))
              (setf hp (binhp:make-heap arr test))
              ;; Now pop all the elements and verify that we get the right order
              (sort arrval test)
              (loop for ind from 0 below nelem do
                    (assert (= (binhp:extract hp) (aref arrval ind))))
              ;; Reinsert shuffled elements.
              (loop for ind from 0 below nelem do
                    (rotatef (aref arrval ind) (aref arrval (random nelem))))
              (loop for elem across arrval do
                    (binhp:insert hp elem))
              ;; Now repop everything and check order.
              (sort arrval test)
              (loop for ind from 0 below nelem do
                    (assert (= (binhp:extract hp) (aref arrval ind)))))))
(format t "OK") (terpri t)
;;; Performance
(terpri t) (format t "Performance:") (terpri t)
(loop for nelem in (list 100 10000 1000000) do
      (let ((arr (make-array nelem :element-type 'double-float
                                   :fill-pointer nelem
                                   :initial-element 0d0))
            (hp nil))
        (loop for ind from 0 below nelem do
              (setf (aref arr ind) (random 100d0)))
        (format t "Building a max-heap of ~a double-floats: " nelem) (terpri t)
        (time (setf hp (binhp:make-heap arr #'>=)))
        (format t "Popping a max-heap of ~a double-floats: " nelem) (terpri t)
        (time (dotimes (it nelem t) (binhp:extract hp)))
        (format t "Reinserting ~a double-floats:" nelem) (terpri t)
        (time (dotimes (it nelem t) (binhp:insert hp (random 100d0))))))

Review

• I am mostly happy with binheap.lisp (but should I be?). Are there any obvious shortcuts that could be used to make the code more elegant/efficient?
• The tests are quite awkward. I validate the library for random cases and do a few performance benchmarks for double-float types. Is there any package that you could recommend for the same kind of tests but in a less awkward way to program and read?

All this testing might be overkill for such a simple and small program, but my goal is to have a self-contained example of a typical, very neat Common-Lisp project. So by all means be nitpicky please.