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