master: Implement sparse sets having greater storage density than SSET
snuglas via Sbcl-commits <[email protected]> Tue, 21 Jul 2026 03:12:56 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 83ec17c0a0afc1dd3f72d6cfd97d798c8e427195 (commit)
from 52b2af5b940dc9f1070d70abcfc79174c8655b9e (commit)
- Log -----------------------------------------------------------------
commit 83ec17c0a0afc1dd3f72d6cfd97d798c8e427195
Author: Douglas Katzman <[email protected]>
Date: Tue Jul 21 03:12:46 2026 +0000
Implement sparse sets having greater storage density than SSET
Not compiled in yet but potentially part of the adaptive CONSET which
dynamically chooses between simple-bit-vector or sparse set of integers.
(Since constraints are indexed by small integers, CONSETs don't need SSETs
that store the constraints themselves - integers will do just fine.)
---
src/cold/build-order.lisp-expr | 1 +
src/cold/exports.lisp | 10 ++
src/compiler/int-sset.lisp | 266 ++++++++++++++++++++++++++++++++++
tests/int-sset.pure.lisp | 314 +++++++++++++++++++++++++++++++++++++++++
4 files changed, 591 insertions(+)
diff --git a/src/cold/build-order.lisp-expr b/src/cold/build-order.lisp-expr
index f7143005b..9a32d3ad8 100644
--- a/src/cold/build-order.lisp-expr
+++ b/src/cold/build-order.lisp-expr
@@ -199,6 +199,7 @@
("src/code/specializable-array" :not-target)
("src/compiler/sset" :c-headers)
+ #+adaptive-conset ("src/compiler/int-sset" :not-host)
;; for e.g. BLOCK-ANNOTATION, needed by "compiler/vop"
("src/compiler/node" :c-headers :block-compile)
;; This has ASSEMBLY-UNIT-related stuff needed by core.lisp.
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 95ce5bb77..7230aef2f 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -2867,6 +2867,16 @@ be submitted as a \\CDR")
"MAP-PACKED-XREF-DATA" "MAP-SIMPLE-FUNS"))
+#+adaptive-conset
+(defpackage "SB-INTEGER-SPARSE-SET"
+ (:use "CL" "SB-INT" "SB-EXT")
+ (:import-from "SB-C" "INSERT-ARRAY-BOUNDS-CHECKS")
+ (:export "MAKE-INT-SSET" "COPY-INT-SSET"
+ "DO-INT-SSET-ELEMENTS" "INT-SSET="
+ "INT-SSET-ADJOIN" "INT-SSET-DELETE" "INT-SSET-MEMBER"
+ "INT-SSET-UNION" "INT-SSET-INTERSECTION" "INT-SSET-DIFFERENCE"
+ "INT-SSET-EMPTY" "INT-SSET-COUNT"))
+
(defpackage "SB-REGALLOC"
(:documentation "private: implementation of the compiler's register allocator")
(:use "CL" "SB-EXT" "SB-INT" "SB-KERNEL" "SB-SYS" "SB-C")
diff --git a/src/compiler/int-sset.lisp b/src/compiler/int-sset.lisp
new file mode 100644
index 000000000..98d2130b0
--- /dev/null
+++ b/src/compiler/int-sset.lisp
@@ -0,0 +1,266 @@
+;;;; This file implements a sparse set abstraction capable of storing only
+;;;; small non-negative integers using heuristics to choose from several
+;;;; representations with the goal of minimizing computational complexity.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB-INTEGER-SPARSE-SET")
+
+;;; These won't be needed after combining this package into SB-C
+(defconstant +sset-rehash-threshold+ 4)
+(declaim (inline sset-hash))
+(defun sset-hash (element-number) (mix element-number 0))
+
+;;; INTEGER-SSETs can logically store 0, but 0 is the physical sentinel value.
+;;; The trick is that we increment the user's value by 1 when storing,
+;;; and decrement when reading out of the array during iteration.
+(deftype int-sset-element () '(integer 0 #xFFFFFFFE))
+(deftype int-sset-stored-value () '(integer 1 #xFFFFFFFF))
+(defmacro int-sset-elt-encode (e) `(1+ ,e))
+(defmacro int-sset-elt-decode (e) `(1- ,e))
+
+(defstruct (integer-sset (:conc-name int-sset-)
+ (:copier nil)
+ (:constructor %make-int-sset (vector %bounds inline-bits)))
+ ;; Vector containing the set values.
+ ;; Using 0 as the empty value is convenient both from a perspective of being the
+ ;; default memory fill value, but also not having to pick different sentinels
+ ;; (such as #xFFFF and #xFFFFFFFF) for the two array specializations allows logic
+ ;; in the algebraic operations to be shared for either specialization.
+ (vector #* :type (or (simple-array (unsigned-byte 16) 1)
+ (simple-array (unsigned-byte 32) 1)
+ simple-bit-vector)) ; not used yet
+ (%bounds 0 :type sb-vm:word)
+ (inline-bits 0 :type sb-vm:word))
+
+(declaim (freeze-type integer-sset))
+
+(defmacro int-sset-limit (x) `(ldb (byte 32 0) (int-sset-%bounds ,x)))
+(defmacro int-sset-count (x) `(ldb (byte 32 32) (int-sset-%bounds ,x)))
+
+(defun make-int-sset ()
+ (declare (inline %make-int-sset))
+ (%make-int-sset #.(sb-xc:make-array 0 :element-type '(unsigned-byte 16)) 0 0))
+
+(declaim (inline int-sset-vector-smallp))
+(defun int-sset-vector-smallp (v)
+ (typep v '(simple-array (unsigned-byte 16))))
+
+;;; Iterate over the elements in SSET, binding VAR to each element in
+;;; turn.
+(defmacro do-int-sset-elements ((var sset &optional result) &body body)
+ (let ((v '#:v) (small'#:small) (i '#:i) (elt '#:e))
+ `(let* ((,v (int-sset-vector ,sset))
+ (,small (int-sset-vector-smallp ,v)))
+ (do ((,i (1- (length ,v)) (1- ,i)))
+ ((minusp ,i) ,result)
+ (declare (sb-kernel:index-or-minus-1 ,i)
+ (optimize (sb-c::insert-array-bounds-checks 0)))
+ (let ((,elt (if ,small
+ (aref (truly-the (simple-array (unsigned-byte 16) 1) ,v) ,i)
+ (aref (truly-the (simple-array (unsigned-byte 32) 1) ,v) ,i))))
+ (unless (eql ,elt 0)
+ (let ((,var (int-sset-elt-decode ,elt))) ,@body)))))))
+
+;; This variant purposely inserts the body twice, which is generally frowned upon
+;; if arbitrary user code is allowed in the body, but is reasonable within
+;; the context of implementating the operations on int-ssets.
+(defmacro unswitched-do-int-sset-elt ((var sset) &body body)
+ (let ((vector '#:vector))
+ `(int-sset-loop-unswitch (,vector (int-sset-vector ,sset))
+ (dovector (,var ,vector) (unless (eql ,var 0) ,@body)))))
+(defmacro int-sset-loop-unswitch ((var expr) &body body)
+ `(let ((,var ,expr))
+ (if (int-sset-vector-smallp ,var)
+ (let ((,var (truly-the (simple-array (unsigned-byte 16) 1) ,var))) ,@body)
+ (let ((,var (truly-the (simple-array (unsigned-byte 32) 1) ,var))) ,@body))))
+
+;;; Double the size of the hash vector of SET.
+(defun int-sset-grow (set)
+ (let* ((vector (int-sset-vector set))
+ (length (* (length vector) 2))
+ (new-vector
+ (if (int-sset-vector-smallp vector)
+ (make-array length :element-type '(unsigned-byte 16) :initial-element 0)
+ (make-array length :element-type '(unsigned-byte 32) :initial-element 0)))
+ (new-limit (- length (truncate length +sset-rehash-threshold+))))
+ (setf (int-sset-vector set) new-vector
+ (int-sset-limit set) new-limit
+ (int-sset-count set) 0)
+ ;; Can't use UNSWITCHED-DO-INT-SSET-ELT here because we're scanning the _old_ vector!
+ (int-sset-loop-unswitch (old-vector vector)
+ (dovector (e old-vector)
+ (unless (eql e 0) (%iss-adjoin e set))))))
+
+;;; Destructively add ELEMENT to SET. If ELEMENT was not in the set,
+;;; then we return true, otherwise we return false.
+(defun %iss-adjoin (element set)
+ (declare (int-sset-stored-value element))
+ #-sb-xc-host (declare (optimize (insert-array-bounds-checks 0)))
+ (let ((vector (int-sset-vector set)))
+ (if (<= element #xFFFF) ; almost always true
+ (when (zerop (length vector))
+ (setf vector (make-array 2 :element-type '(unsigned-byte 16) :initial-element 0)
+ (int-sset-vector set) vector
+ (int-sset-limit set) 1))
+ ;; Ensure the vector can hold (UNSIGNED-BYTE 32). No extra test is needed for 0-length
+ ;; vectors because they are always of element-type (UNSIGNED-BYTE 16).
+ (when (int-sset-vector-smallp vector)
+ (let ((new-vector (make-array (max 2 (length vector)) :element-type '(unsigned-byte 32)
+ :initial-element 0)))
+ (setf vector (cond ((plusp (length vector)) (replace new-vector vector))
+ (t (setf (int-sset-limit set) 1) new-vector))
+ (int-sset-vector set) new-vector))))
+ (int-sset-loop-unswitch (vector vector)
+ (loop with mask = (truly-the index (1- (length vector)))
+ for hash of-type index = (logand mask (sset-hash element)) then (logand mask (1+ hash))
+ for current = (aref vector hash)
+ do (cond ((eql current 0)
+ (setf (aref vector hash) element)
+ (when (> (incf (int-sset-count set)) (int-sset-limit set))
+ (int-sset-grow set))
+ (return t))
+ ((eql current element)
+ (return nil)))))))
+(defun int-sset-adjoin (element set)
+ (declare (type int-sset-element element))
+ (%iss-adjoin (int-sset-elt-encode element) set))
+
+;;; Destructively remove ELEMENT from SET. If element was in the set,
+;;; then return true, otherwise return false.
+(defun %iss-delete (element set)
+ (declare (int-sset-stored-value element))
+ #-sb-xc-host (declare (optimize (insert-array-bounds-checks 0)))
+ (when (zerop (int-sset-count set))
+ (return-from %iss-delete nil))
+ (int-sset-loop-unswitch (vector (int-sset-vector set))
+ (loop with mask = (truly-the index (1- (length vector)))
+ for hash = (logand mask (sset-hash element)) then (logand mask (1+ hash))
+ for current = (aref vector hash)
+ do (cond ((eql current 0)
+ (return nil))
+ ((eql current element)
+ ;; COUNT was nonzero, so it can't become negative.
+ ;; Compiler isn't inferring that, so inform it.
+ (setf (int-sset-count set) (truly-the index (1- (int-sset-count set))))
+ (do ((i hash)) (nil)
+ (do ((j (logand mask (1+ i)) (logand mask (1+ j)))) (nil)
+ (declare (index j))
+ (let ((candidate (aref vector j)))
+ (when (eql candidate 0)
+ (setf (aref vector i) 0)
+ (return-from %iss-delete t))
+ (let ((n candidate))
+ (when (>= (logand mask (- j (logand mask (sset-hash n))))
+ (logand mask (- j i)))
+ (setf (aref vector i) candidate i j)
+ (return)))))))))))
+
+(defun int-sset-delete (element set)
+ (declare (type int-sset-element element))
+ (%iss-delete (int-sset-elt-encode element) set))
+
+;;; Return true if ELEMENT is in SET, false otherwise.
+(defun %iss-member (element set)
+ (declare (int-sset-stored-value element))
+ #-sb-xc-host (declare (optimize (insert-array-bounds-checks 0)))
+ (int-sset-loop-unswitch (vector (int-sset-vector set))
+ (loop with mask = (truly-the index (1- (length vector)))
+ for hash of-type index = (logand mask (sset-hash element)) then
+ (logand mask (1+ hash))
+ for current = (aref vector hash)
+ do (cond ((eql current element) (return t))
+ ((eql current 0) (return nil))))))
+
+(defun int-sset-member (element set)
+ (declare (type int-sset-element element))
+ (and (/= 0 (int-sset-count set))
+ (%iss-member (int-sset-elt-encode element) set)))
+
+(defun int-sset= (set1 set2)
+ (unless (eql (int-sset-count set1) (int-sset-count set2))
+ (return-from int-sset= nil))
+ (unswitched-do-int-sset-elt (e set1)
+ (unless (%iss-member e set2)
+ (return-from int-sset= nil)))
+ t)
+
+;;; Return true if SET contains no elements, false otherwise.
+(declaim (inline int-sset-empty))
+(defun int-sset-empty (set) (= 0 (int-sset-count set)))
+
+;;; Return a new copy of SET.
+(defun copy-int-sset (set)
+ (%make-int-sset (copy-seq (int-sset-vector set))
+ (int-sset-%bounds set) (int-sset-inline-bits set)))
+
+;;; Perform the appropriate set operation on SET1 and SET2 by
+;;; destructively modifying SET1. We return true if SET1 was modified,
+;;; false otherwise.
+(defun int-sset-union (set1 set2 &aux modified)
+ (unswitched-do-int-sset-elt (element set2)
+ (when (%iss-adjoin element set1)
+ (setf modified t)))
+ modified)
+
+(defun int-sset-intersection (set1 set2)
+ (cond
+ ((or (int-sset-empty set1) (eq set1 set2)) nil)
+ ;; Consing can always be bounded by the cardinality of the smaller set,
+ ;; we just have to decide whether to collect items to ADJOIN vs DELETE.
+ ;; In the situation where SET2 is empty (and SET1 is not, because empty was
+ ;; ruled out above), this correctly pick the first of the following two COND
+ ;; clauses, doing zero consing.
+ ;; When SET2 is no more than half the size of SET1, collecting kept elements
+ ;; by scanning SET2 conses at most |SET2| items, whereas scanning SET1
+ ;; conses at least |SET1| - |SET2| items.
+ ((<= (int-sset-count set2) (ash (int-sset-count set1) -1))
+ (let ((to-keep nil))
+ (unswitched-do-int-sset-elt (element set2)
+ (when (%iss-member element set1)
+ (push element to-keep)))
+ (fill (int-sset-vector set1) 0)
+ (setf (int-sset-count set1) 0)
+ ;; Since |SET2| < |SET1|, SET1 is guaranteed to shrink, so we always return T.
+ (dolist (element to-keep t)
+ (%iss-adjoin element set1))))
+ (t
+ (let ((to-delete nil))
+ (unswitched-do-int-sset-elt (element set1)
+ (unless (%iss-member element set2)
+ (push element to-delete)))
+ (when to-delete
+ (dolist (element to-delete t)
+ (%iss-delete element set1)))))))
+
+(defun int-sset-difference (set1 set2)
+ ;; 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 (int-sset-count set2) -1) (int-sset-count set1)) ; allow 2x larger SET2
+ (let (modified)
+ (unswitched-do-int-sset-elt (element set2)
+ (when (%iss-delete element set1)
+ (setq modified t)))
+ modified))
+ (t
+ (let ((to-delete nil))
+ (unswitched-do-int-sset-elt (element set1)
+ (when (%iss-member element set2)
+ (push element to-delete)))
+ (when to-delete
+ (dolist (element to-delete t)
+ (%iss-delete element set1)))))))
diff --git a/tests/int-sset.pure.lisp b/tests/int-sset.pure.lisp
new file mode 100644
index 000000000..d25150854
--- /dev/null
+++ b/tests/int-sset.pure.lisp
@@ -0,0 +1,314 @@
+#-adaptive-conset (invoke-restart 'run-tests::skip-file)
+
+(import sb-integer-sparse-set::'(make-int-sset int-sset-adjoin int-sset-delete copy-int-sset
+ int-sset-union int-sset-intersection int-sset-difference
+ int-sset-member int-sset-empty
+ int-sset-vector int-sset-count int-sset-limit
+ do-int-sset-elements int-sset-vector-smallp))
+
+(with-test (:name :new-int-sset-basic-operations)
+ (let ((set (make-int-sset))
+ (e1 10)
+ (e2 20)
+ (e3 30)
+ (e4 40))
+ (assert (int-sset-empty set))
+ (assert (not (int-sset-member e1 set)))
+
+ ;; Adjoin
+ (assert (int-sset-adjoin e1 set))
+ (assert (not (int-sset-adjoin e1 set))) ; already present
+ (assert (int-sset-adjoin e2 set))
+ (assert (int-sset-adjoin e3 set))
+ (assert (= (int-sset-count set) 3))
+ (assert (int-sset-member e1 set))
+ (assert (int-sset-member e2 set))
+ (assert (int-sset-member e3 set))
+ (assert (not (int-sset-member e4 set)))
+
+ ;; Delete
+ (assert (int-sset-delete e2 set))
+ (assert (not (int-sset-delete e2 set))) ; already deleted
+ (assert (= (int-sset-count set) 2))
+ (assert (int-sset-member e1 set))
+ (assert (not (int-sset-member e2 set)))
+ (assert (int-sset-member e3 set))
+
+ (assert (int-sset-delete e1 set))
+ (assert (int-sset-delete e3 set))
+ (assert (int-sset-empty set))))
+
+(with-test (:name :new-int-sset-shift-deletion-stress)
+ (let ((set (make-int-sset))
+ (elems (loop for i from 1 to 100 collect i)))
+ (dolist (e elems)
+ (int-sset-adjoin e set))
+ (assert (= (int-sset-count set) 100))
+ ;; Delete every second element
+ (loop for e in elems by #'cddr
+ do (assert (int-sset-delete e set)))
+ (assert (= (int-sset-count set) 50))
+ (loop for e in elems
+ for i from 0
+ do (if (evenp i)
+ (assert (not (int-sset-member e set)))
+ (assert (int-sset-member e set))))
+ (loop for e in (cdr elems) by #'cddr
+ do (assert (int-sset-delete e set)))
+ (assert (int-sset-empty set))))
+
+(with-test (:name :new-int-sset-set-operations)
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset))
+ (e1 1)
+ (e2 2)
+ (e3 3)
+ (e4 4))
+ (int-sset-adjoin e1 s1)
+ (int-sset-adjoin e2 s1)
+ (int-sset-adjoin e3 s1)
+
+ (int-sset-adjoin e2 s2)
+ (int-sset-adjoin e3 s2)
+ (int-sset-adjoin e4 s2)
+
+ ;; Union
+ (let ((u (copy-int-sset s1)))
+ (int-sset-union u s2)
+ (assert (= (int-sset-count u) 4))
+ (assert (int-sset-member e4 u)))
+
+ ;; Intersection
+ (let ((i (copy-int-sset s1)))
+ (int-sset-intersection i s2)
+ (assert (= (int-sset-count i) 2))
+ (assert (not (int-sset-member e1 i)))
+ (assert (int-sset-member e2 i))
+ (assert (int-sset-member e3 i)))
+
+ ;; Difference
+ (let ((d (copy-int-sset s1)))
+ (int-sset-difference d s2)
+ (assert (= (int-sset-count d) 1))
+ (assert (int-sset-member e1 d))
+ (assert (not (int-sset-member e2 d)))
+ (assert (not (int-sset-member e3 d))))))
+
+(with-test (:name :int-sset-growth-optimization)
+ (let ((set (make-int-sset))
+ (e1 1)
+ (e2 2))
+ ;; Initially empty, limit is 0
+ (assert (zerop (int-sset-limit set)))
+ (assert (= (length (int-sset-vector set)) 0))
+
+ ;; Adjoin e1. Should grow to size 2, and count reaches limit.
+ (assert (int-sset-adjoin e1 set))
+ (assert (= (int-sset-count set) (int-sset-limit set)))
+ (assert (= (length (int-sset-vector set)) 2))
+
+ ;; Adjoin e1 again. Should NOT grow.
+ (assert (not (int-sset-adjoin e1 set)))
+ (assert (= (int-sset-count set) (int-sset-limit set)))
+ (assert (= (length (int-sset-vector set)) 2))
+
+ ;; Adjoin e2. Should grow to size 4.
+ (assert (int-sset-adjoin e2 set))
+ (assert (= (length (int-sset-vector set)) 4))))
+
+(with-test (:name :int-sset-difference-comprehensive)
+ (let ((elems (loop for i from 1 to 20 collect i)))
+ ;; 1. Small set2, large set1 (Branch 1: set2 <= 2*set1)
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (dolist (e (subseq elems 0 10)) (int-sset-adjoin e s1))
+ (dolist (e (subseq elems 3 6)) (int-sset-adjoin e s2)) ; s2 has 3 elements
+ (assert (int-sset-difference s1 s2)) ; modified = t
+ (assert (= (int-sset-count s1) 7))
+ (assert (not (int-sset-member (elt elems 3) s1)))
+ (assert (not (int-sset-member (elt elems 4) s1)))
+ (assert (not (int-sset-member (elt elems 5) s1)))
+ (assert (int-sset-member (elt elems 0) s1))
+ ;; No modification when subtracting disjoint set
+ (let ((s3 (make-int-sset)))
+ (int-sset-adjoin (elt elems 3) s3)
+ (assert (not (int-sset-difference s1 s3))) ; modified = nil
+ (assert (= (int-sset-count s1) 7))))
+
+ ;; 2. Large set2, small set1 (Branch 2: set2 > 2*set1)
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (dolist (e (subseq elems 0 3)) (int-sset-adjoin e s1)) ; s1 has 3 elements
+ (dolist (e (subseq elems 2 15)) (int-sset-adjoin e s2)) ; s2 has 13 elements
+ (assert (int-sset-difference s1 s2)) ; modified = t
+ (assert (= (int-sset-count s1) 2)) ; element 2 removed
+ (assert (not (int-sset-member (elt elems 2) s1)))
+ (assert (int-sset-member (elt elems 0) s1))
+ (assert (int-sset-member (elt elems 1) s1)))
+
+ ;; 3. (int-sset-difference s s) - self difference triggers aver error
+ (let ((s (make-int-sset)))
+ (dolist (e (subseq elems 0 5)) (int-sset-adjoin e s))
+ (assert-error (int-sset-difference s s)))
+
+ ;; 4. Empty set operations
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (int-sset-adjoin (elt elems 0) s1)
+ ;; Subtract empty from non-empty
+ (assert (not (int-sset-difference s1 s2))) ; modified = nil
+ (assert (= (int-sset-count s1) 1))
+ ;; Subtract non-empty from empty
+ (assert (not (int-sset-difference s2 s1))) ; modified = nil
+ (assert (int-sset-empty s2)))))
+
+(with-test (:name :int-sset-intersection-comprehensive)
+ (let ((elems (loop for i from 1 to 20 collect i)))
+ ;; 1. Small set2, large set1 (Branch 1: set2 <= set1/2)
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (dolist (e (subseq elems 0 10)) (int-sset-adjoin e s1)) ; s1 has 10 elements
+ (dolist (e (subseq elems 3 6)) (int-sset-adjoin e s2)) ; s2 has 3 elements
+ (assert (int-sset-intersection s1 s2)) ; modified = t
+ (assert (= (int-sset-count s1) 3))
+ (assert (int-sset-member (elt elems 3) s1))
+ (assert (int-sset-member (elt elems 4) s1))
+ (assert (int-sset-member (elt elems 5) s1))
+ (assert (not (int-sset-member (elt elems 0) s1)))
+ (assert (not (int-sset-member (elt elems 9) s1)))
+
+ ;; Intersecting with small disjoint set empties s1
+ (let ((s3 (make-int-sset)))
+ (dolist (e (subseq elems 15 17)) (int-sset-adjoin e s3))
+ (assert (int-sset-intersection s1 s3)) ; modified = t
+ (assert (int-sset-empty s1))))
+
+ ;; 2. Large set2, small set1 (Branch 2: set2 > set1/2)
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (dolist (e (subseq elems 0 4)) (int-sset-adjoin e s1)) ; s1 has 4 elements
+ (dolist (e (subseq elems 2 12)) (int-sset-adjoin e s2)) ; s2 has 10 elements
+ (assert (int-sset-intersection s1 s2)) ; modified = t
+ (assert (= (int-sset-count s1) 2))
+ (assert (int-sset-member (elt elems 2) s1))
+ (assert (int-sset-member (elt elems 3) s1))
+ (assert (not (int-sset-member (elt elems 0) s1)))
+
+ ;; Intersecting when set2 contains all elements of set1 (unmodified = nil)
+ (let ((s4 (make-int-sset)))
+ (dolist (e (subseq elems 0 10)) (int-sset-adjoin e s4)) ; contains all of s1
+ (assert (not (int-sset-intersection s1 s4))) ; modified = nil
+ (assert (= (int-sset-count s1) 2))))
+
+ ;; 3. (eq set1 set2) returns nil (unmodified)
+ (let ((s1 (make-int-sset)))
+ (dolist (e (subseq elems 0 5)) (int-sset-adjoin e s1))
+ (assert (not (int-sset-intersection s1 s1)))
+ (assert (= (int-sset-count s1) 5)))
+
+ ;; 4. Empty set operations
+ (let ((s1 (make-int-sset))
+ (s2 (make-int-sset)))
+ (int-sset-adjoin (elt elems 0) s1)
+ ;; Intersect non-empty with empty (s2 <= s1/2 => returns t, s1 becomes empty)
+ (assert (int-sset-intersection s1 s2))
+ (assert (int-sset-empty s1))
+ ;; Intersect empty with non-empty (returns nil)
+ (int-sset-adjoin (elt elems 0) s2)
+ (assert (not (int-sset-intersection s1 s2)))
+ (assert (int-sset-empty s1)))))
+
+(with-test (:name :int-sset-zero-element)
+ (let ((set (make-int-sset)))
+ (assert (int-sset-empty set))
+ (assert (not (int-sset-member 0 set)))
+ ;; Adjoin 0
+ (assert (int-sset-adjoin 0 set))
+ (assert (find 1 (int-sset-vector set)))
+ (assert (not (int-sset-adjoin 0 set))) ; already present
+ (assert (= (int-sset-count set) 1))
+ (assert (int-sset-member 0 set))
+ (assert (not (int-sset-empty set)))
+
+ ;; do-int-sset-elements yields 0 (biased down by 1)
+ (let (collected)
+ (do-int-sset-elements (e set)
+ (push e collected))
+ (assert (equal collected '(0))))
+
+ ;; Adjoin other elements alongside 0
+ (assert (int-sset-adjoin 10 set))
+ (assert (int-sset-adjoin 20 set))
+ (assert (= (int-sset-count set) 3))
+ (assert (int-sset-member 0 set))
+ (assert (int-sset-member 10 set))
+ (assert (int-sset-member 20 set))
+
+ ;; Set operations with 0
+ (let ((s2 (make-int-sset)))
+ (int-sset-adjoin 0 s2)
+ (int-sset-adjoin 30 s2)
+ (let ((u (copy-int-sset set)))
+ (int-sset-union u s2)
+ (assert (int-sset-member 0 u))
+ (assert (= (int-sset-count u) 4)))
+ (let ((i (copy-int-sset set)))
+ (int-sset-intersection i s2)
+ (assert (int-sset-member 0 i))
+ (assert (= (int-sset-count i) 1)))
+ (let ((d (copy-int-sset set)))
+ (int-sset-difference d s2)
+ (assert (not (int-sset-member 0 d)))
+ (assert (= (int-sset-count d) 2))))
+
+ ;; Delete 0
+ (assert (int-sset-delete 0 set))
+ (assert (not (int-sset-member 0 set)))
+ (assert (= (int-sset-count set) 2))))
+
+(with-test (:name :int-sset-array-type-upgrade)
+ (let ((set (make-int-sset)))
+ ;; 1. Small elements and #xFFFE (whose stored bit pattern is #xFFFF) fit in (unsigned-byte 16)
+ (int-sset-adjoin 0 set)
+ (int-sset-adjoin 42 set)
+ (int-sset-adjoin #xFFFE set)
+ (assert (int-sset-vector-smallp (int-sset-vector set)))
+ (assert (typep (int-sset-vector set) '(simple-array (unsigned-byte 16) (*))))
+ (assert (int-sset-member 0 set))
+ (assert (int-sset-member 42 set))
+ (assert (int-sset-member #xFFFE set))
+
+ ;; 2. Inserting #xFFFF (logically 65535, stored as #x10000) exceeds (unsigned-byte 16) storage
+ ;; and transparently upgrades the backing array to (unsigned-byte 32).
+ (assert (int-sset-adjoin #xFFFF set))
+ (assert (not (int-sset-vector-smallp (int-sset-vector set))))
+ (assert (typep (int-sset-vector set) '(simple-array (unsigned-byte 32) (*))))
+ (assert (int-sset-member 0 set))
+ (assert (int-sset-member 42 set))
+ (assert (int-sset-member #xFFFE set))
+ (assert (int-sset-member #xFFFF set))
+
+ ;; 3. Further insertions of large numbers into upgraded set
+ (assert (int-sset-adjoin #x12345678 set))
+ (assert (int-sset-adjoin #xFFFFFFFE set))
+ (assert (int-sset-member #x12345678 set))
+ (assert (int-sset-member #xFFFFFFFE set))
+ (assert (= (int-sset-count set) 6))
+
+ ;; 4. Directly inserting large numbers into a fresh empty set
+ (let ((set2 (make-int-sset)))
+ (assert (int-sset-adjoin #xFFFF set2))
+ (assert (not (int-sset-vector-smallp (int-sset-vector set2))))
+ (assert (typep (int-sset-vector set2) '(simple-array (unsigned-byte 32) (*))))
+ (assert (int-sset-member #xFFFF set2)))
+
+ ;; 5. Union of (unsigned-byte 16) set with (unsigned-byte 32) set upgrades the target set
+ (let ((small-set (make-int-sset))
+ (large-set (make-int-sset)))
+ (int-sset-adjoin 1 small-set)
+ (assert (int-sset-vector-smallp (int-sset-vector small-set)))
+ (int-sset-adjoin #xFFFF large-set)
+ (int-sset-union small-set large-set)
+ (assert (not (int-sset-vector-smallp (int-sset-vector small-set))))
+ (assert (int-sset-member 1 small-set))
+ (assert (int-sset-member #xFFFF small-set)))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL