master: Change #-conset-is-sset to #+bitmapped-conset
snuglas via Sbcl-commits <[email protected]> Tue, 28 Jul 2026 16:34:34 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 76d957fcc77c2782f831a9d70dce383b7820b958 (commit)
from 250bd9f16767a5c4644b23a8ff57c0f3e9843e54 (commit)
- Log -----------------------------------------------------------------
commit 76d957fcc77c2782f831a9d70dce383b7820b958
Author: Douglas Katzman <[email protected]>
Date: Tue Jul 28 16:26:05 2026 +0000
Change #-conset-is-sset to #+bitmapped-conset
Allowing a third mutually exclusive choice of #+adaptive-conset.
Also remove the FLET from do-conset-constraints-intersection.
---
src/compiler/constraint.lisp | 41 ++++++++++++++++++++---------------------
1 file changed, 20 insertions(+), 21 deletions(-)
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index f506c70fe..6d9a4f5a4 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -133,8 +133,8 @@
;;; for constraint propagation, or if bit-vectors on some XC host
;;; really lose compared to SSETs, here's the conset API as a wrapper
;;; around SSETs:
-#+nil
-(eval-when (:compile-toplevel :execute) (push :conset-is-sset sb-xc:*features*))
+#-conset-is-sset
+(eval-when (:compile-toplevel :execute) (pushnew :bitmapped-conset sb-xc:*features*))
#+conset-is-sset
(progn
(deftype conset () 'sset)
@@ -182,7 +182,7 @@
;;; 9 66 1.4 210 4.4 3857 81.0 - (FLET SB-C::BODY-FUN :IN SB-C::TYPE-FROM-CONSTRAINTS)
;;; 10 58 1.2 123 2.6 3915 82.2 - SB-KERNEL::%TYPE-INTERSECTION
-#-conset-is-sset
+#+bitmapped-conset
(locally
;; This is performance critical for the compiler, and benefits
;; from the following declarations. Probably you'll want to
@@ -495,7 +495,7 @@
;;; equality or emptiness testing. There's also union, but that's only an
;;; optimisation to avoid useless copies in ADD-TEST-CONSTRAINTS and
;;; FIND-BLOCK-TYPE-CONSTRAINTS.
-#-conset-is-sset
+#+bitmapped-conset
(defmacro do-conset-elements ((constraint conset &optional result) &body body)
(let ((index '#:index) ; gensym considered harmful
(conset-vector '#:conset-vector)
@@ -550,29 +550,28 @@
(defmacro do-conset-constraints-intersection ((symbol (conset constraints) &optional result)
&body body)
(let ((min (gensym "MIN"))
- (max (gensym "MAX")))
+ (max (gensym "MAX"))
+ (vect '#:v)
+ (i '#:i))
(declare (ignorable min max))
(once-only ((conset conset)
(constraints constraints))
- `(flet ((body (,symbol)
- (declare (type constraint ,symbol))
- ,@body))
+ `(progn
(when ,constraints
- (let (#-conset-is-sset (,min (conset-min ,conset))
- #-conset-is-sset (,max (conset-max ,conset))
- (vector #-sb-xc-host (truly-the simple-vector (%array-data ,constraints))
+ (let (#+bitmapped-conset (,min (conset-min ,conset))
+ #+bitmapped-conset (,max (conset-max ,conset))
+ (,vect #-sb-xc-host (truly-the simple-vector (%array-data ,constraints))
#+sb-xc-host ,constraints))
#-sb-xc-host (declare (optimize (insert-array-bounds-checks 0)))
- (loop for i below (length ,constraints)
- for constraint = (aref vector i)
- when #-conset-is-sset
- (let ((number (truly-the index (constraint-number
- (truly-the constraint constraint)))))
- (and (<= ,min number)
- (< number ,max)
- (conset-member constraint ,conset)))
- #+conset-is-sset (conset-member constraint ,conset)
- do (body constraint))))
+ ;; CONSTRAINTS has a fill-pointer. DOVECTOR would wrongly visit the
+ ;; entirety of the underlying simple-vector.
+ (loop for ,i below (length ,constraints)
+ for ,symbol = (truly-the constraint (aref ,vect ,i))
+ when #+bitmapped-conset
+ (let ((n (truly-the index (constraint-number ,symbol))))
+ (and (<= ,min n) (< n ,max) (conset-member ,symbol ,conset)))
+ #-bitmapped-conset (conset-member ,symbol ,conset)
+ do (progn ,@body))))
,result))))
(defmacro do-eql-vars ((symbol (var constraints) &optional result) &body body)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL