(in-package :cl-user)
(defvar *old-pprint-dispatch* *print-pprint-dispatch*)

(setf *print-pprint-dispatch*
      (copy-pprint-dispatch *old-pprint-dispatch*))

(defun pprint-hashtable (s hash-table)
  (pprint-logical-block (s nil)
    (princ "#<hash-table"  s)
    (let ((v (fset:convert 'list (fset:convert 'fset:map hash-table))))
      (when v
        (pprint-logical-block (s v)
          (pprint-indent :block 0 s)
          (loop do
            (destructuring-bind (key . value) (pprint-pop)
              (format s " ~s: ~s" key value)
              (pprint-exit-if-list-exhausted)
              (princ ", " s)
              (pprint-newline :mandatory s))))))
    (princ #\> s)))

(set-pprint-dispatch 'hash-table 'pprint-hashtable)