# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1481220981 18000
# Node ID d5f5a30b7eeeee762c0cff2e7942baa7f43e40fa
# Parent  1c23d569319274f0a19943e962fbc8f492749d9f
Add basic hash set implementation

diff -r 1c23d5693192 -r d5f5a30b7eee DOCUMENTATION.markdown
--- a/DOCUMENTATION.markdown	Tue Nov 22 21:40:35 2016 +0000
+++ b/DOCUMENTATION.markdown	Thu Dec 08 13:16:21 2016 -0500
@@ -504,6 +504,177 @@
 
   
 
+## Package `LOSH.HASH-SETS`
+
+Simple hash set implementation.
+
+### `COPY-HASH-SET` (function)
+
+    (COPY-HASH-SET INSTANCE)
+
+### `HASH-SET` (struct)
+
+Slots: `STORAGE`
+
+### `HSET-CLEAR!` (function)
+
+    (HSET-CLEAR! HSET)
+
+Remove all elements from `hset`.
+
+  Returns nothing.
+
+  
+
+### `HSET-CONTAINS-P` (function)
+
+    (HSET-CONTAINS-P HSET ELEMENT)
+
+Return whether `hset` contains `element`.
+
+### `HSET-COUNT` (function)
+
+    (HSET-COUNT HSET)
+
+Return the number of elements in `hset`.
+
+### `HSET-DIFFERENCE` (function)
+
+    (HSET-DIFFERENCE HSET &REST OTHERS)
+
+Return a fresh hash set containing the difference of the given hash sets.
+
+### `HSET-DIFFERENCE!` (function)
+
+    (HSET-DIFFERENCE! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the difference of itself with `others`.
+
+### `HSET-ELEMENTS` (function)
+
+    (HSET-ELEMENTS HSET)
+
+Return a fresh list containing the elements of `hset`.
+
+### `HSET-EMPTY-P` (function)
+
+    (HSET-EMPTY-P HSET)
+
+Return whether `hset` is empty.
+
+### `HSET-FILTER` (function)
+
+    (HSET-FILTER HSET PREDICATE)
+
+Return a fresh hash set containing elements of `hset` satisfying `predicate`.
+
+### `HSET-FILTER!` (function)
+
+    (HSET-FILTER! HSET PREDICATE)
+
+Destructively update `hset` to contain only elements satisfying `predicate`.
+
+### `HSET-INSERT!` (function)
+
+    (HSET-INSERT! HSET &REST ELEMENTS)
+
+Insert each element in `elements` into `hset`.
+
+  Returns nothing.
+
+  
+
+### `HSET-INTERSECTION` (function)
+
+    (HSET-INTERSECTION HSET &REST OTHERS)
+
+Return a fresh hash set containing the intersection of the given hash sets.
+
+### `HSET-INTERSECTION!` (function)
+
+    (HSET-INTERSECTION! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the intersection of itself with `others`.
+
+### `HSET-MAP` (function)
+
+    (HSET-MAP HSET FUNCTION &KEY NEW-TEST)
+
+Return a fresh hash set containing the results of calling `function` on elements of `hset`.
+
+  If `new-test` is given, the new hash set will use this as it's `test`.
+
+  
+
+### `HSET-MAP!` (function)
+
+    (HSET-MAP! HSET FUNCTION &KEY NEW-TEST)
+
+Destructively update `hset` by calling `function` on each element.
+
+   If `new-test` is given the hash set's `test` will be updated.
+
+   
+
+### `HSET-POP!` (function)
+
+    (HSET-POP! HSET)
+
+Remove and return an arbitrarily-chosen element from `hset`.
+
+  An error will be signaled if the hash set is empty.
+
+  
+
+### `HSET-REMOVE!` (function)
+
+    (HSET-REMOVE! HSET &REST ELEMENTS)
+
+Remove each element in `elements` from `hset`.
+
+  If an element is not in `hset`, it will be ignored.
+
+  Returns nothing.
+
+  
+
+### `HSET-UNION` (function)
+
+    (HSET-UNION HSET &REST OTHERS)
+
+Return a fresh hash set containing the union of the given hash sets.
+
+### `HSET-UNION!` (function)
+
+    (HSET-UNION! HSET &REST OTHERS)
+
+Destructively update `hset` to contain the union of itself with `others`.
+
+### `HSET=` (function)
+
+    (HSET= HSET &REST OTHERS)
+
+Return whether all the given hash sets contain exactly the same elements.
+
+  All the hash sets are assumed to use the same `test` -- the consequences are
+  undefined if this is not the case.
+
+  
+
+### `MAKE-HASH-SET` (function)
+
+    (MAKE-HASH-SET &KEY (TEST 'EQL) (SIZE 16) (INITIAL-CONTENTS 'NIL))
+
+Create a fresh hash set.
+
+  `size` should be a hint as to how many elements this set is expected to
+  contain.
+
+  `initial-contents` should be a sequence of initial elements for the set
+  (duplicates are fine).
+
+  
+
 ## Package `LOSH.HASH-TABLES`
 
 Utilities for operating on hash tables.
diff -r 1c23d5693192 -r d5f5a30b7eee losh.lisp
--- a/losh.lisp	Tue Nov 22 21:40:35 2016 +0000
+++ b/losh.lisp	Thu Dec 08 13:16:21 2016 -0500
@@ -47,6 +47,11 @@
 (defconstant 7/8tau (* tau 7/8))
 
 
+(defun-inline not= (number &rest more-numbers)
+  "Return `nil` if all arguments are numerically equal, `t` otherwise."
+  (not (apply #'= number more-numbers)))
+
+
 (defun-inline degrees (radians)
   "Convert `radians` into degrees.
 
@@ -1499,6 +1504,7 @@
   Handy for block-commenting multiple expressions.
 
   "
+  (declare (ignore body))
   nil)
 
 
@@ -1604,7 +1610,7 @@
 (defun stop-profiling (&optional (filename "lisp.prof"))
   "Stop profiling performance and dump a report to `filename`.  SBCL only."
   (sb-sprof::stop-profiling)
-  (dump-profile))
+  (dump-profile filename))
 
 
 ;;;; Weightlists --------------------------------------------------------------
@@ -1633,6 +1639,223 @@
     (finding item :such-that (< n weight))))
 
 
+;;;; Hash Sets ----------------------------------------------------------------
+(defstruct (hash-set (:constructor make-hash-set%))
+  (storage (error "Required") :type hash-table :read-only t))
+
+(defmethod print-object ((hset hash-set) stream)
+  (print-unreadable-object (hset stream :type t :identity t)
+    (format stream "~:S" (hset-elements hset))))
+
+
+(defun make-hash-set (&key (test 'eql) (size 16) (initial-contents '()))
+  "Create a fresh hash set.
+
+  `size` should be a hint as to how many elements this set is expected to
+  contain.
+
+  `initial-contents` should be a sequence of initial elements for the set
+  (duplicates are fine).
+
+  "
+  (let* ((result (make-hash-set% :storage (make-hash-table :test test
+                                                           :size size))))
+    (map nil (curry #'hset-insert! result) initial-contents)
+    result))
+
+(defun copy-hash-set (hset)
+  "Create a (shallow) copy of the given hash set.
+
+  Only the storage for the hash set itself will be copied -- the elements
+  themselves will not be copied.
+
+  "
+  (make-hash-set% :storage (copy-hash-table (hash-set-storage hset))))
+
+
+(defmacro define-hset-op (name arglist &body body)
+  (let* ((has-docstring (stringp (first body)))
+         (docstring (if has-docstring
+                     (first body)
+                     ""))
+         (body (if has-docstring
+                 (rest body)
+                 body)))
+    `(defun ,name ,arglist
+      ,docstring
+      (with-slots (storage) ,(first arglist)
+       ,@body))))
+
+
+(define-hset-op hset-empty-p (hset)
+  "Return whether `hset` is empty."
+  (zerop (hash-table-count storage)))
+
+(define-hset-op hset-contains-p (hset element)
+  "Return whether `hset` contains `element`."
+  (values (gethash element storage)))
+
+(define-hset-op hset-count (hset)
+  "Return the number of elements in `hset`."
+  (hash-table-count storage))
+
+(define-hset-op hset-insert! (hset &rest elements)
+  "Insert each element in `elements` into `hset`.
+
+  Returns nothing.
+
+  "
+  (dolist (element elements)
+    (setf (gethash element storage) t))
+  (values))
+
+(define-hset-op hset-remove! (hset &rest elements)
+  "Remove each element in `elements` from `hset`.
+
+  If an element is not in `hset`, it will be ignored.
+
+  Returns nothing.
+
+  "
+  (dolist (element elements)
+    (remhash element storage))
+  (values))
+
+(define-hset-op hset-pop! (hset)
+  "Remove and return an arbitrarily-chosen element from `hset`.
+
+  An error will be signaled if the hash set is empty.
+
+  "
+  (assert (not (hset-empty-p hset))
+      (hset)
+    "Cannot pop from empty hash set ~S"
+    hset)
+  (iterate (for (k nil) :in-hashtable storage)
+           (remhash k storage)
+           (return k)))
+
+(define-hset-op hset-clear! (hset)
+  "Remove all elements from `hset`.
+
+  Returns nothing.
+
+  "
+  (clrhash storage)
+  (values))
+
+
+(define-hset-op hset=% (hset other)
+  (iterate (for (k nil) :in-hashtable storage)
+           (when (not (hset-contains-p other k))
+             (return nil))
+           (finally (return t))))
+
+(define-hset-op hset= (hset &rest others)
+  "Return whether all the given hash sets contain exactly the same elements.
+
+  All the hash sets are assumed to use the same `test` -- the consequences are
+  undefined if this is not the case.
+
+  "
+  (if (apply #'not= (hset-count hset) (mapcar #'hset-count others))
+    nil
+    (iterate (for other :in others)
+             (when (not (hset=% hset other))
+               (return nil))
+             (finally (return t)))))
+
+
+(define-hset-op hset-union!% (hset other)
+  (iterate (for (k nil) :in-hashtable (hash-set-storage other))
+           (hset-insert! hset k))
+  hset)
+
+(define-hset-op hset-union! (hset &rest others)
+  "Destructively update `hset` to contain the union of itself with `others`."
+  (reduce #'hset-union!% others :initial-value hset))
+
+(define-hset-op hset-union (hset &rest others)
+  "Return a fresh hash set containing the union of the given hash sets."
+  (apply #'hset-union! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-intersection!% (hset other)
+  (iterate (for (k nil) :in-hashtable storage)
+           (when (not (hset-contains-p other k))
+             (remhash k storage)))
+  hset)
+
+(define-hset-op hset-intersection! (hset &rest others)
+  "Destructively update `hset` to contain the intersection of itself with `others`."
+  (reduce #'hset-intersection!% others :initial-value hset))
+
+(define-hset-op hset-intersection (hset &rest others)
+  "Return a fresh hash set containing the intersection of the given hash sets."
+  (apply #'hset-intersection! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-difference!% (hset other)
+  (iterate (for (k nil) :in-hashtable (hash-set-storage other))
+           (remhash k storage))
+  hset)
+
+(define-hset-op hset-difference! (hset &rest others)
+  "Destructively update `hset` to contain the difference of itself with `others`."
+  (reduce #'hset-difference!% others :initial-value hset))
+
+(define-hset-op hset-difference (hset &rest others)
+  "Return a fresh hash set containing the difference of the given hash sets."
+  (apply #'hset-difference! (copy-hash-set hset) others))
+
+
+(define-hset-op hset-filter! (hset predicate)
+  "Destructively update `hset` to contain only elements satisfying `predicate`."
+  (iterate (for (k nil) :in-hashtable storage)
+           (when (funcall predicate k)
+             (remhash k storage))))
+
+(define-hset-op hset-filter (hset predicate)
+  "Return a fresh hash set containing elements of `hset` satisfying `predicate`."
+  (let ((new (copy-hash-set hset)))
+    (hset-filter! new predicate)
+    new))
+
+
+(define-hset-op hset-map! (hset function &key new-test)
+  "Destructively update `hset` by calling `function` on each element.
+
+   If `new-test` is given the hash set's `test` will be updated.
+
+   "
+  (let ((results (iterate (for (k nil) :in-hashtable storage)
+                          (collect (funcall function k)))))
+    (if new-test
+      ;; Rebuild the underlying hash table if we have a new test.
+      (setf storage (make-hash-table :test new-test
+                                     :size (hash-table-count storage)))
+      ;; Otherwise just clear and reuse the existing one.
+      (clrhash storage))
+    (dolist (k results)
+      (hset-insert! hset k))
+    nil))
+
+(define-hset-op hset-map (hset function &key new-test)
+  "Return a fresh hash set containing the results of calling `function` on elements of `hset`.
+
+  If `new-test` is given, the new hash set will use this as it's `test`.
+
+  "
+  (let ((new (copy-hash-set hset)))
+    (hset-map! new function :new-test new-test)
+    new))
+
+
+(define-hset-op hset-elements (hset)
+  "Return a fresh list containing the elements of `hset`."
+  (hash-table-keys storage))
+
+
 ;;;; Bit Sets -----------------------------------------------------------------
 ;;; Implementation of the sets-as-integers idea in the Common Lisp Recipes book.
 (deftype bset () '(integer 0))
diff -r 1c23d5693192 -r d5f5a30b7eee make-docs.lisp
--- a/make-docs.lisp	Tue Nov 22 21:40:35 2016 +0000
+++ b/make-docs.lisp	Thu Dec 08 13:16:21 2016 -0500
@@ -8,6 +8,7 @@
         "LOSH.DEBUGGING"
         "LOSH.ELDRITCH-HORRORS"
         "LOSH.FUNCTIONS"
+        "LOSH.HASH-SETS"
         "LOSH.HASH-TABLES"
         "LOSH.ITERATE"
         "LOSH.LICENSING"
diff -r 1c23d5693192 -r d5f5a30b7eee package.lisp
--- a/package.lisp	Tue Nov 22 21:40:35 2016 +0000
+++ b/package.lisp	Thu Dec 08 13:16:21 2016 -0500
@@ -150,6 +150,36 @@
   (:export
     :mutate-hash-values))
 
+(defpackage :losh.hash-sets
+  (:documentation "Simple hash set implementation.")
+  (:export
+    :hash-set
+    :make-hash-set
+    :copy-hash-set
+
+    :hset-empty-p
+    :hset-contains-p
+    :hset-elements
+    :hset-count
+
+    :hset-insert!
+    :hset-remove!
+    :hset-pop!
+    :hset-clear!
+
+    :hset=
+
+    :hset-union
+    :hset-union!
+    :hset-intersection
+    :hset-intersection!
+    :hset-difference
+    :hset-difference!
+    :hset-filter
+    :hset-filter!
+    :hset-map
+    :hset-map!))
+
 (defpackage :losh.sequences
   (:documentation "Utilities for operating on sequences.")
   (:export
@@ -203,6 +233,7 @@
    :losh.debugging
    :losh.eldritch-horrors
    :losh.functions
+   :losh.hash-sets
    :losh.hash-tables
    :losh.iterate
    :losh.licensing
diff -r 1c23d5693192 -r d5f5a30b7eee vendor/make-quickutils.lisp
--- a/vendor/make-quickutils.lisp	Tue Nov 22 21:40:35 2016 +0000
+++ b/vendor/make-quickutils.lisp	Thu Dec 08 13:16:21 2016 -0500
@@ -5,6 +5,7 @@
   :utilities '(
 
                :compose
+               :copy-hash-table
                :curry
                :emptyp
                :ensure-keyword
diff -r 1c23d5693192 -r d5f5a30b7eee vendor/quickutils.lisp
--- a/vendor/quickutils.lisp	Tue Nov 22 21:40:35 2016 +0000
+++ b/vendor/quickutils.lisp	Thu Dec 08 13:16:21 2016 -0500
@@ -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 :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :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")
@@ -14,13 +14,13 @@
 
 (when (boundp '*utilities*)
   (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))))
+                                         :COMPOSE :COPY-HASH-TABLE :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))))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defun make-gensym-list (length &optional (x "G"))
     "Returns a list of `length` gensyms, each generated as if with a call to `make-gensym`,
@@ -74,6 +74,29 @@
              ,(compose-1 funs))))))
   
 
+  (defun copy-hash-table (table &key key test size
+                                     rehash-size rehash-threshold)
+    "Returns a copy of hash table `table`, with the same keys and values
+as the `table`. The copy has the same properties as the original, unless
+overridden by the keyword arguments.
+
+Before each of the original values is set into the new hash-table, `key`
+is invoked on the value. As `key` defaults to `cl:identity`, a shallow
+copy is returned by default."
+    (setf key (or key 'identity))
+    (setf test (or test (hash-table-test table)))
+    (setf size (or size (hash-table-size table)))
+    (setf rehash-size (or rehash-size (hash-table-rehash-size table)))
+    (setf rehash-threshold (or rehash-threshold (hash-table-rehash-threshold table)))
+    (let ((copy (make-hash-table :test test :size size
+                                 :rehash-size rehash-size
+                                 :rehash-threshold rehash-threshold)))
+      (maphash (lambda (k v)
+                 (setf (gethash k copy) (funcall key v)))
+               table)
+      copy))
+  
+
   (defun curry (function &rest arguments)
     "Returns a function that applies `arguments` and the arguments
 it is called with to `function`."
@@ -294,8 +317,8 @@
     `(with-gensyms ,names ,@forms))
   
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (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)))
+  (export '(compose copy-hash-table 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 ;;;;