master: Optimize SSET-DIFFERENCE

The branch "master" has been updated in SBCL:
       via  26a27bc8d8ccf9a921c950463f77c4f1533eb5b3 (commit)
      from  246af004128d9e0d567bacf79a61c7acf43b2512 (commit)

- Log -----------------------------------------------------------------
commit 26a27bc8d8ccf9a921c950463f77c4f1533eb5b3
Author: Douglas Katzman <[email protected]>
Date:   Sat Jul 18 23:06:28 2026 -0400

    Optimize SSET-DIFFERENCE
    
    Iterating over the second set is preferred as it avoids an intermediate list,
    and is worse only if the second set is much larger than the first.
    
    Test cases by Gemini
---
 src/compiler/sset.lisp | 34 +++++++++++++++++++++++++++-------
 tests/sset.pure.lisp   | 45 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+), 7 deletions(-)

diff --git a/src/compiler/sset.lisp b/src/compiler/sset.lisp
index c17fa8942..c9b31f9e2 100644
--- a/src/compiler/sset.lisp
+++ b/src/compiler/sset.lisp
@@ -178,6 +178,11 @@
         finally (return modified)))
 
 (defun sset-intersection (set1 set2)
+  ;; If SET2 is _significantly_ smaller than SET1 it would make sense to
+  ;; iterate over SET2 looking for the elements that are in SET1.
+  ;; However, to do that means consing a new temporary SSET, performing
+  ;; the operation, then moving the temporary on top of SET1.
+  ;; I don't feel like doing all that.
   (let ((to-delete nil))
     (do-sset-elements (element set1)
       (unless (sset-member element set2)
@@ -187,13 +192,28 @@
         (sset-delete element set1)))))
 
 (defun sset-difference (set1 set2)
-  (let ((to-delete nil))
-    (do-sset-elements (element set1)
-      (when (sset-member element set2)
-        (push element to-delete)))
-    (when to-delete
-      (dolist (element to-delete t)
-        (sset-delete element set1)))))
+  ;; If sets are EQ, the algorithms below are either terribly broken (if you pick
+  ;; the first cond clause) or terribly stupid (if you pick the second).
+  ;; The result should technically be an empty set, but we don't need it.
+  (aver (neq set1 set2))
+  ;; If SET2 is smaller than SET1, or possibly even larger by an allowance,
+  ;; we should prefer to scan all of it, calling SSET-DELETE on each item.
+  ;; This technique never conses a list of items to delete.
+  ;; When SET1 drives iteration, we can not both delete from and iterate over it,
+  ;; so we necessarily cons an intermediate list.
+  (cond ((<= (ash (sset-count set2) -1) (sset-count set1)) ; allow 2x larger SET2
+         (let (modified)
+           (do-sset-elements (element set2 modified)
+             (when (sset-delete element set1)
+               (setq modified t)))))
+        (t
+         (let ((to-delete nil))
+           (do-sset-elements (element set1)
+             (when (sset-member element set2)
+               (push element to-delete)))
+           (when to-delete
+             (dolist (element to-delete t)
+               (sset-delete element set1)))))))
 
 ;;; Destructively modify SET1 to include its union with the difference
 ;;; of SET2 and SET3. We return true if SET1 was modified, false
diff --git a/tests/sset.pure.lisp b/tests/sset.pure.lisp
index 51a0503d6..16d9c4f94 100644
--- a/tests/sset.pure.lisp
+++ b/tests/sset.pure.lisp
@@ -133,3 +133,48 @@
     (assert (sset-adjoin e2 set))
     (assert (= (length (sset-vector set)) 4))))
 
+(with-test (:name :sset-difference-comprehensive)
+  (let ((elems (loop for i from 1 to 20 collect (make-dummy-test-element i))))
+    ;; 1. Small set2, large set1 (Branch 1: set2 <= 2*set1)
+    (let ((s1 (make-sset))
+          (s2 (make-sset)))
+      (dolist (e (subseq elems 0 10)) (sset-adjoin e s1))
+      (dolist (e (subseq elems 3 6))  (sset-adjoin e s2)) ; s2 has 3 elements
+      (assert (sset-difference s1 s2)) ; modified = t
+      (assert (= (sset-count s1) 7))
+      (assert (not (sset-member (elt elems 3) s1)))
+      (assert (not (sset-member (elt elems 4) s1)))
+      (assert (not (sset-member (elt elems 5) s1)))
+      (assert (sset-member (elt elems 0) s1))
+      ;; No modification when subtracting disjoint set
+      (let ((s3 (make-sset)))
+        (sset-adjoin (elt elems 3) s3)
+        (assert (not (sset-difference s1 s3))) ; modified = nil
+        (assert (= (sset-count s1) 7))))
+
+    ;; 2. Large set2, small set1 (Branch 2: set2 > 2*set1)
+    (let ((s1 (make-sset))
+          (s2 (make-sset)))
+      (dolist (e (subseq elems 0 3))  (sset-adjoin e s1)) ; s1 has 3 elements
+      (dolist (e (subseq elems 2 15)) (sset-adjoin e s2)) ; s2 has 13 elements
+      (assert (sset-difference s1 s2)) ; modified = t
+      (assert (= (sset-count s1) 2)) ; element 2 removed
+      (assert (not (sset-member (elt elems 2) s1)))
+      (assert (sset-member (elt elems 0) s1))
+      (assert (sset-member (elt elems 1) s1)))
+
+    ;; 3. (sset-difference s s) - self difference triggers aver error
+    (let ((s (make-sset)))
+      (dolist (e (subseq elems 0 5)) (sset-adjoin e s))
+      (assert-error (sset-difference s s)))
+
+    ;; 4. Empty set operations
+    (let ((s1 (make-sset))
+          (s2 (make-sset)))
+      (sset-adjoin (elt elems 0) s1)
+      ;; Subtract empty from non-empty
+      (assert (not (sset-difference s1 s2))) ; modified = nil
+      (assert (= (sset-count s1) 1))
+      ;; Subtract non-empty from empty
+      (assert (not (sset-difference s2 s1))) ; modified = nil
+      (assert (sset-empty s2)))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL