Add `(reductions ... :result-type ...)` argument
author |
Steve Losh <steve@stevelosh.com> |
date |
Tue, 20 Feb 2024 11:36:38 -0500 |
parents |
04ad2212b90f |
children |
(none) |
(in-package :losh.hash-tables)
(defun mutate-hash-values (function hash-table)
"Replace each value in `hash-table` with the result of calling `function` on it.
Returns the hash table.
"
(iterate (for (key value) :in-hashtable hash-table)
(setf (gethash key hash-table)
(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)))
(defun remhash-if (test hash-table)
"Remove elements which satisfy `(test key value)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(when (funcall test k v)
(remhash k hash-table)))
hash-table)
hash-table)
(defun remhash-if-not (test hash-table)
"Remove elements which don't satisfy `(test key value)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(unless (funcall test k v)
(remhash k hash-table)))
hash-table)
hash-table)
(defun remhash-if-key (test hash-table)
"Remove elements which satisfy `(test key)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(declare (ignore v))
(when (funcall test k)
(remhash k hash-table)))
hash-table)
hash-table)
(defun remhash-if-not-key (test hash-table)
"Remove elements which satisfy don't `(test key)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(declare (ignore v))
(unless (funcall test k)
(remhash k hash-table)))
hash-table)
hash-table)
(defun remhash-if-value (test hash-table)
"Remove elements which satisfy `(test value)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(when (funcall test v)
(remhash k hash-table)))
hash-table)
hash-table)
(defun remhash-if-not-value (test hash-table)
"Remove elements which satisfy don't `(test value)` from `hash-table`.
Returns the hash table."
(maphash (lambda (k v)
(unless (funcall test v)
(remhash k hash-table)))
hash-table)
hash-table)
(defun ht/eql (&rest keys-and-values)
(alexandria:plist-hash-table keys-and-values :test 'eql))
(defun ht/equal (&rest keys-and-values)
(alexandria:plist-hash-table keys-and-values :test 'equal))
(named-readtables:defreadtable hash-table-constructor-syntax
(:merge :standard)
(:macro-char #\{ (lambda (stream char)
(declare (ignore char))
`(ht/eql ,@(read-delimited-list #\} stream t))))
(:macro-char #\# :dispatch)
(:dispatch-macro-char #\# #\{ (lambda (stream char n)
(declare (ignore char n))
`(ht/equal ,@(read-delimited-list #\} stream t))))
(:macro-char #\} (get-macro-character #\) nil)))