# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1484998154 0
# Node ID 8b5c27a2d2de1476a6738f88f3cc0c58905ae8aa
# Parent  ba324d052c50c52a46171c012454d931d46a113f
Add some hash table printing stuff

diff -r ba324d052c50 -r 8b5c27a2d2de DOCUMENTATION.markdown
--- a/DOCUMENTATION.markdown	Fri Jan 20 23:47:44 2017 +0000
+++ b/DOCUMENTATION.markdown	Sat Jan 21 11:29:14 2017 +0000
@@ -546,6 +546,10 @@
 
 Print a pretty representation of `hash-table` to `stream.`
 
+  Respects `*print-length*` when printing the elements.
+
+  
+
 ### `PRINT-TABLE` (function)
 
     (PRINT-TABLE ROWS)
@@ -963,6 +967,12 @@
 
 Utilities for operating on hash tables.
 
+### `HASH-TABLE-CONTENTS` (function)
+
+    (HASH-TABLE-CONTENTS HASH-TABLE)
+
+Return a fresh list of `(key value)` elements of `hash-table`.
+
 ### `MUTATE-HASH-VALUES` (function)
 
     (MUTATE-HASH-VALUES FUNCTION HASH-TABLE)
diff -r ba324d052c50 -r 8b5c27a2d2de losh.lisp
--- a/losh.lisp	Fri Jan 20 23:47:44 2017 +0000
+++ b/losh.lisp	Sat Jan 21 11:29:14 2017 +0000
@@ -1518,6 +1518,10 @@
                  (funcall function value)))
   hash-table)
 
+(defun hash-table-contents (hash-table)
+  "Return a fresh list of `(key value)` elements of `hash-table`."
+  (gathering (maphash (compose #'gather #'list) hash-table)))
+
 
 ;;;; Sequences ----------------------------------------------------------------
 (defun prefix-sums (sequence)
@@ -1845,7 +1849,11 @@
 
 
 (defun print-hash-table (hash-table &optional (stream t))
-  "Print a pretty representation of `hash-table` to `stream.`"
+  "Print a pretty representation of `hash-table` to `stream.`
+
+  Respects `*print-length*` when printing the elements.
+
+  "
   (let* ((keys (hash-table-keys hash-table))
          (vals (hash-table-values hash-table))
          (count (hash-table-count hash-table))
@@ -1853,7 +1861,7 @@
                       (mapcar (compose #'length #'prin1-to-string) <>)
                       (reduce #'max <> :initial-value 0)
                       (clamp 0 20 <>))))
-    (print-unreadable-object (hash-table stream :type t :identity nil)
+    (print-unreadable-object (hash-table stream :type t)
       (princ
         ;; Something shits the bed and output gets jumbled (in SBCL at least) if
         ;; we try to print to `stream` directly in the format statement inside
@@ -1875,6 +1883,20 @@
   (terpri stream)
   (values))
 
+(defun print-hash-table-concisely (hash-table &optional (stream t))
+  "Print a concise representation of `hash-table` to `stream.`
+
+  Should respect `*print-length*` when printing the elements.
+
+  "
+  (print-unreadable-object (hash-table stream :type t)
+    (prin1 (hash-table-test hash-table))
+    (write-char #\space stream)
+    (prin1 (hash-table-contents hash-table) stream)))
+
+(defmethod print-object ((object hash-table) stream)
+  (print-hash-table-concisely object stream))
+
 
 #+sbcl
 (defun dump-profile (filename)
diff -r ba324d052c50 -r 8b5c27a2d2de package.lisp
--- a/package.lisp	Fri Jan 20 23:47:44 2017 +0000
+++ b/package.lisp	Sat Jan 21 11:29:14 2017 +0000
@@ -79,7 +79,8 @@
     #+sbcl :start-profiling
     #+sbcl :stop-profiling
     :print-table
-    :print-hash-table))
+    :print-hash-table
+    :print-concisely))
 
 (defpackage :losh.eldritch-horrors
   (:documentation "Abandon all hope, ye who enter here.")
@@ -135,6 +136,7 @@
 (defpackage :losh.hash-tables
   (:documentation "Utilities for operating on hash tables.")
   (:export
+    :hash-table-contents
     :mutate-hash-values))
 
 (defpackage :losh.iterate