# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1474978434 0
# Node ID f1e161fed238d219bae416ec97b3db29029c1c30
# Parent  8f9411271fd7a224f4a8de73eec57a7b1f4600aa
Add `print-hash-table`

diff -r 8f9411271fd7 -r f1e161fed238 losh.lisp
--- a/losh.lisp	Mon Sep 26 18:02:46 2016 +0000
+++ b/losh.lisp	Tue Sep 27 12:13:54 2016 +0000
@@ -1,6 +1,17 @@
 (in-package #:losh)
 
 
+;;;; Sanity
+(defmacro -<> (&rest forms)
+  ;; I am going to lose my fucking mind if I have to program lisp without
+  ;; a threading macro, but I don't want to add another dep to this library, so
+  ;; here we are.
+  (if (null forms)
+    '<>
+    `(let ((<> ,(first forms)))
+       (-<> ,@(rest forms)))))
+
+
 ;;;; Chili Dogs
 (defmacro defun-inlineable (name &body body)
   `(progn
@@ -1330,6 +1341,31 @@
   (values))
 
 
+(defun print-hash-table (hash-table &optional (stream t))
+  "Print a pretty representation of `hash-table` to `stream.`"
+  (let* ((keys (hash-table-keys hash-table))
+         (vals (hash-table-values hash-table))
+         (count (hash-table-count hash-table))
+         (key-width (-<> keys
+                      (mapcar (compose #'length #'prin1-to-string) <>)
+                      (reduce #'max <> :initial-value 0)
+                      (clamp 0 20 <>))))
+    (print-unreadable-object (hash-table stream :type t :identity nil)
+      (format stream ":test ~A :count ~D {~%~{~{  ~vs ~s~}~%~}}"
+              (hash-table-test hash-table)
+              count
+              (loop
+                :with limit = 40
+                :for key :in keys
+                :for val :in vals
+                :for i :from 0 :to limit
+                :collect (if (= i limit)
+                           (list key-width 'too-many-items (list (- count i) 'more))
+                           (list key-width key val)))))))
+
+
+
+
 ;;;; Weightlists
 (defstruct (weightlist (:constructor %make-weightlist))
   weights sums items total)
diff -r 8f9411271fd7 -r f1e161fed238 package.lisp
--- a/package.lisp	Mon Sep 26 18:02:46 2016 +0000
+++ b/package.lisp	Tue Sep 27 12:13:54 2016 +0000
@@ -170,7 +170,8 @@
     #:dis
     #:aesthetic-string
     #:structural-string
-    #:print-table))
+    #:print-table
+    #:print-hash-table))
 
 (defpackage #:losh.weightlists
   (:documentation
diff -r 8f9411271fd7 -r f1e161fed238 vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Mon Sep 26 18:02:46 2016 +0000
+++ b/vendor/make-quickutils.lisp	Tue Sep 27 12:13:54 2016 +0000
@@ -10,6 +10,8 @@
                :ensure-keyword
                :ensure-list
                :flatten
+               :hash-table-keys
+               :hash-table-values
                :map-tree
                :mkstr
                :once-only
diff -r 8f9411271fd7 -r f1e161fed238 vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Mon Sep 26 18:02:46 2016 +0000
+++ b/vendor/quickutils.lisp	Tue Sep 27 12:13:54 2016 +0000
@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "LOSH.QUICKUTILS")
@@ -16,6 +16,8 @@
   (setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
                                          :COMPOSE :CURRY :NON-ZERO-P :EMPTYP
                                          :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN
+                                         :MAPHASH-KEYS :HASH-TABLE-KEYS
+                                         :MAPHASH-VALUES :HASH-TABLE-VALUES
                                          :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY
                                          :SYMB :WEAVE :STRING-DESIGNATOR
                                          :WITH-GENSYMS))))
@@ -127,6 +129,42 @@
       (rec xs nil)))
   
 
+  (declaim (inline maphash-keys))
+  (defun maphash-keys (function table)
+    "Like `maphash`, but calls `function` with each key in the hash table `table`."
+    (maphash (lambda (k v)
+               (declare (ignore v))
+               (funcall function k))
+             table))
+  
+
+  (defun hash-table-keys (table)
+    "Returns a list containing the keys of hash table `table`."
+    (let ((keys nil))
+      (maphash-keys (lambda (k)
+                      (push k keys))
+                    table)
+      keys))
+  
+
+  (declaim (inline maphash-values))
+  (defun maphash-values (function table)
+    "Like `maphash`, but calls `function` with each value in the hash table `table`."
+    (maphash (lambda (k v)
+               (declare (ignore k))
+               (funcall function v))
+             table))
+  
+
+  (defun hash-table-values (table)
+    "Returns a list containing the values of hash table `table`."
+    (let ((values nil))
+      (maphash-values (lambda (v)
+                        (push v values))
+                      table)
+      values))
+  
+
   (defun map-tree (function tree)
     "Map `function` to each of the leave of `tree`."
     (check-type tree cons)
@@ -256,7 +294,8 @@
     `(with-gensyms ,names ,@forms))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (export '(compose curry emptyp ensure-keyword ensure-list flatten map-tree
-            mkstr once-only rcurry symb weave with-gensyms with-unique-names)))
+  (export '(compose curry emptyp ensure-keyword ensure-list flatten
+            hash-table-keys hash-table-values map-tree mkstr once-only rcurry
+            symb weave with-gensyms with-unique-names)))
 
 ;;;; END OF quickutils.lisp ;;;;