GitLab

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.

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

Raymond Toy pushed to branch issue-240-clean-up-hashtable-impl at cmucl / cmucl

Commits:

1 changed file:

Changes: