Skip to content
Snippets Groups Projects
Commit 9581820a authored by Raymond Toy's avatar Raymond Toy
Browse files

Address #240: Clean up hashtable implementation of set functions

parent a5b2c0f8
No related branches found
No related tags found
No related merge requests found
...@@ -750,6 +750,28 @@ ...@@ -750,6 +750,28 @@
15) 15)
(declaim (start-block list-to-hashtable union intersection set-difference)) (declaim (start-block list-to-hashtable union intersection set-difference))
;; Main code to process a set function. INIT-RES initializes the
;; value of RES, which holds the result of the set function.
;; TEST-FORM is a form that tests whether to add the item from LIST1
;; to RES.
(defmacro process-set-body (init-res invert-p test-form)
`(let ((res ,init-res))
(dolist (item list1)
(when ,(if invert-p
`(not ,test-form)
test-form)
(push item res)))
res))
(defmacro process-set (init-res invert-p)
`(let ((hashtable (list-to-hashtable list2 key test test-not)))
(if hashtable
(process-set-body ,init-res ,invert-p
(nth-value 1 (gethash (apply-key key item) hashtable)))
(process-set-body ,init-res ,invert-p
(with-set-keys (member (apply-key key item) list2))))))
;; Convert a list to a hashtable. The hashtable does not handle ;; Convert a list to a hashtable. The hashtable does not handle
;; duplicated values in the list. Returns the hashtable. ;; duplicated values in the list. Returns the hashtable.
(defun list-to-hashtable (list key test test-not) (defun list-to-hashtable (list key test test-not)
...@@ -791,17 +813,7 @@ ...@@ -791,17 +813,7 @@
(declare (inline member)) (declare (inline member))
(when (and testp notp) (when (and testp notp)
(error (intl:gettext "Test and test-not both supplied."))) (error (intl:gettext "Test and test-not both supplied.")))
(let ((res list2) (process-set list2 t))
(hashtable (list-to-hashtable list2 key test test-not)))
(cond (hashtable
(dolist (item list1)
(unless (nth-value 1 (gethash (apply-key key item) hashtable))
(push item res))))
((null hashtable)
(dolist (item list1)
(unless (with-set-keys (member (apply-key key item) list2))
(push item res)))))
res))
(defun intersection (list1 list2 &key key (defun intersection (list1 list2 &key key
...@@ -810,20 +822,7 @@ ...@@ -810,20 +822,7 @@
(declare (inline member)) (declare (inline member))
(if (and testp notp) (if (and testp notp)
(error "Test and test-not both supplied.")) (error "Test and test-not both supplied."))
(let ((hashtable (process-set nil nil))
(list-to-hashtable list2 key test test-not)))
(cond (hashtable
(let ((res nil))
(dolist (item list1)
(when (nth-value 1 (gethash (apply-key key item) hashtable))
(push item res)))
res))
((null hashtable)
(let ((res nil))
(dolist (elt list1)
(if (with-set-keys (member (apply-key key elt) list2))
(push elt res)))
res)))))
(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) (defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp))
"Returns the elements of list1 which are not in list2." "Returns the elements of list1 which are not in list2."
...@@ -834,23 +833,8 @@ ...@@ -834,23 +833,8 @@
(when (null list2) (when (null list2)
(return-from set-difference list1)) (return-from set-difference list1))
(let ((hashtable (process-set nil t))
(list-to-hashtable list2 key test test-not)))
(cond (hashtable
;; list2 was placed in hash table.
(let ((res nil))
(dolist (item list1)
(unless (nth-value 1 (gethash (apply-key key item) hashtable))
(push item res)))
res))
((null hashtable)
;; Default implementation because we didn't create the hash
;; table.
(let ((res nil))
(dolist (item list1)
(if (not (with-set-keys (member (apply-key key item) list2)))
(push item res)))
res)))))
(declaim (end-block)) (declaim (end-block))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment