Raymond Toy pushed to branch issue-240-clean-up-hashtable-impl at cmucl / cmucl
Commits: e6f1cc3e by Raymond Toy at 2023-08-22T16:30:18-07:00 Refactor the body of set ops
The set functions have basically exactly the same body with the only difference being how the result list is initialized; the test form used to determine how the result list is updated; and whether a hashtable is used or not.
Place all of the common stuff in the macro PROCESS-SET and rename the old PROCESS-SET to PROCESS-SET-BODY.
- - - - - b4d8cfea by Raymond Toy at 2023-08-22T16:31:34-07:00 Remove commented out code
- - - - -
1 changed file:
- src/code/list.lisp
Changes:
===================================== src/code/list.lisp ===================================== @@ -755,13 +755,23 @@ ;; 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 (init-res test-form) +(defmacro process-set-body (init-res invert-p test-form) `(let ((res ,init-res)) (dolist (item list1) - (when ,test-form + (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 ;; duplicated values in the list. Returns the hashtable. (defun list-to-hashtable (list key test test-not) @@ -803,10 +813,7 @@ (declare (inline member)) (when (and testp notp) (error (intl:gettext "Test and test-not both supplied."))) - (let ((hashtable (list-to-hashtable list2 key test test-not))) - (if hashtable - (process-set list2 (not (nth-value 1 (gethash (apply-key key item) hashtable)))) - (process-set list2 (not (with-set-keys (member (apply-key key item) list2))))))) + (process-set list2 t))
(defun intersection (list1 list2 &key key @@ -815,11 +822,7 @@ (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) - (let ((hashtable - (list-to-hashtable list2 key test test-not))) - (if hashtable - (process-set nil (nth-value 1 (gethash (apply-key key item) hashtable))) - (process-set nil (with-set-keys (member (apply-key key item) list2)))))) + (process-set nil nil))
(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Returns the elements of list1 which are not in list2." @@ -830,11 +833,7 @@ (when (null list2) (return-from set-difference list1))
- (let ((hashtable - (list-to-hashtable list2 key test test-not))) - (if hashtable - (process-set nil (not (nth-value 1 (gethash (apply-key key item) hashtable)))) - (process-set nil (not (with-set-keys (member (apply-key key item) list2))))))) + (process-set nil t))
(declaim (end-block))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d046100fe1e8dc2aa9e2b53...