--- 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)
--- 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
--- 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
--- 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 ;;;;