You're right about the consing, though. It seems like there should be a lazy way of doing keys. But then, best hard-codes calls to both car and cdr upon the sequence. So, it looks like we'd be resigned to doing it by hand, and I'm not sure it's any better:

  (unless (bhpq!buckets bhpq!top)
    (= bhpq!top nil)
    (each (priority elt) bhpq!buckets
      (when (bhpq!< priority bhpq!top)
        (= bhpq!top priority))))

  arc> (= q (bhpq 10))
  #hash((top . 11) (buckets . #hash()) (height . 10) (< . #<procedure:<>))
  arc> (bhpq-push 1 'hi q)
  (hi)
  arc> (bhpq-pop q)
  hi
  arc> (bhpq-push 1 'bye q)
  Error: "<: expects type <real number> as 2nd argument, given: nil; other arguments were: 1"

  ; Top element of the abstract comparison operator bhpq!< (though we assume
  ; the operator compares integers!).
  (def bhpq-top (bhpq (o < bhpq!<) (o h bhpq!height))
    (best ~< (list (+ h 1) -1)))

  (def bhpq (h (o < <))
    (obj top     (bhpq-top nil < h)
         height  h
         buckets (table)
         < <))

  (def bhpq-push (priority elt bhpq)
    (unless (<= 0 priority bhpq!height)
      (err (+ "Priority must be between 0 and " bhpq!height ":") priority))
    (zap [best bhpq!< (list _ priority)] bhpq!top)
    (push elt bhpq!buckets.priority))

  (def bhpq-peek (bhpq)
    (car (bhpq!buckets bhpq!top)))

  ; Not as concise, but less consing/breaking
  (def bhpq-pop (bhpq)
    (do1 (pop (bhpq!buckets bhpq!top))
         (unless (bhpq!buckets bhpq!top)
           (= bhpq!top (bhpq-top bhpq))
           (each (priority elt) bhpq!buckets
             (when (bhpq!< priority bhpq!top)
               (= bhpq!top priority))))))