master: intersection: use hash-tables

stassats via Sbcl-commits <[email protected]> Wed, 13 May 2026 21:09:31 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  99cf2439f404b58784aafded14f4d53273723c2c (commit)
      from  c2b343bb56443c6f97eb050b687bce34a136bb57 (commit)

- Log -----------------------------------------------------------------
commit 99cf2439f404b58784aafded14f4d53273723c2c
Author: Stas Boukarev <[email protected]>
Date:   Wed May 13 23:53:45 2026 +0300

    intersection: use hash-tables
---
 src/code/list.lisp  | 31 +++++++++++++++++++++++--------
 tests/ansi-tests.sh |  1 +
 2 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/src/code/list.lisp b/src/code/list.lisp
index 4de2a56e3..4b32f3a8c 100644
--- a/src/code/list.lisp
+++ b/src/code/list.lisp
@@ -20,8 +20,7 @@
 (declaim (maybe-inline
           tree-equal %setnth nthcdr nth
           tailp
-          #| union nunion |# ; what the ????
-          intersection nintersection set-difference nset-difference
+          set-difference nset-difference
           set-exclusive-or nset-exclusive-or subsetp acons
           subst subst-if
           ;; NSUBLIS is >400 lines of assembly. How is it helpful to inline?
@@ -1099,7 +1098,7 @@
                        ((endp long) short)
                      (if (funcall member-test elt orig key test)
                          (pop long)
-                         (shiftf long (cdr long) short long))))))))))))
+                         (shiftf long (cdr long) short long)))))))))))
 
 (defun intersection (list1 list2
                      &key key (test nil testp) (test-not nil notp))
@@ -1110,11 +1109,27 @@
     (error ":TEST and :TEST-NOT were both supplied."))
   (with-member-test (member-test)
     (when (and list1 list2)
-      (let ((res nil))
-        (dolist (elt list1)
-          (when (funcall member-test elt list2 key test)
-            (push elt res)))
-        res))))
+      (multiple-value-bind (short long short-length long-nthcdr)
+          (shorter-list-length list1 list2)
+        (let ((res nil)
+              (hash-table (hashing-p notp testp test short-length long-nthcdr)))
+          (cond (hash-table
+                 (dolist (elt short)
+                   (setf (gethash (apply-key key elt) hash-table) t))
+                 (dolist (elt long)
+                   (when (gethash (apply-key key elt) hash-table)
+                     (push elt res))))
+                (t
+                 (flet ((swapped-test (x y)
+                          (funcall (truly-the function test) y x)))
+                    (declare (dynamic-extent #'swapped-test))
+                   (let ((test (if (eq list1 short)
+                                   test
+                                   (and test #'swapped-test))))
+                     (dolist (elt short)
+                       (when (funcall member-test elt long key test)
+                         (push elt res)))))))
+          res))))))
 
 (defun nintersection (list1 list2
                       &key key (test nil testp) (test-not nil notp))
diff --git a/tests/ansi-tests.sh b/tests/ansi-tests.sh
index 6e807d0e3..2480981f5 100755
--- a/tests/ansi-tests.sh
+++ b/tests/ansi-tests.sh
@@ -56,6 +56,7 @@ rm -fr sandbox/scratch
  "SUBSTITUTE-IF.FOLD.3" "SUBSTITUTE-IF.FOLD.2" "SUBSTITUTE-IF.FOLD.1"
  "SUBSTITUTE.FOLD.4" "SUBSTITUTE.FOLD.3" "SUBSTITUTE.FOLD.2"
  "SUBSTITUTE.FOLD.1"  "SUBSTITUTE-IF-NOT.FOLD.3"
+ "INTERSECTION.FOLD.1"
  "MISC.598" "IMAGPART.4" "SHARED-INITIALIZE.ERROR.4"
  (append #+x86 (list "CIS.4")
          #+(or arm riscv (and arm64 (not darwin)))

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


hooks/post-receive
-- 
SBCL