master: Fix CONSET-ADJOIN and CONSET-UNION
snuglas via Sbcl-commits <[email protected]> Fri, 12 Jun 2026 22:56:52 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 90ee741bec3bc80a3a65c1ba8bf8d32ac4747133 (commit)
from 9ea58046248223f8a2f8bacc12dcddeb75d55f7d (commit)
- Log -----------------------------------------------------------------
commit 90ee741bec3bc80a3a65c1ba8bf8d32ac4747133
Author: Douglas Katzman <[email protected]>
Date: Fri Jun 12 18:48:08 2026 -0400
Fix CONSET-ADJOIN and CONSET-UNION
Those two are easy but in general rescanning for lowest/highest used indices
on every operation won't be a win. (We could store a "recompute" flag which
the iterator macro notices, and tries to tighten the bounds)
DELETE could test whether you're deleting the lowest or highest element as
a special case, and I'm not certain if interection and set-difference admit
any simple improvement at all.
---
src/compiler/constraint.lisp | 30 ++++++++++++++++++++----------
1 file changed, 20 insertions(+), 10 deletions(-)
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index e98905d4c..ffb03323a 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -187,7 +187,7 @@
;; over the whole vector. Tracking extrema helps a bit.
;; [Well, it _should_ help if you do it right. We need sentinel
;; values that are not mistakable for actual indices]
- (min 0 :type fixnum) ; BUG: min of 0 and %constraint-number is always 0
+ (min 0 :type fixnum)
(max 0 :type fixnum))
#+sb-devel
@@ -234,9 +234,14 @@
(let ((number (%constraint-number constraint)))
(conset-grow conset (1+ number))
(setf (sbit (conset-vector conset) number) 1)
- (setf (conset-min conset) (min number (conset-min conset)))
- (when (>= number (conset-max conset))
- (setf (conset-max conset) (1+ number))))
+ (cond
+ ((eql (conset-min conset) (conset-max conset)) ; it must be empty if so
+ (setf (conset-min conset) number
+ (conset-max conset) (1+ number)))
+ (t
+ (setf (conset-min conset) (min number (conset-min conset)))
+ (when (>= number (conset-max conset))
+ (setf (conset-max conset) (1+ number))))))
conset)
(defun conset-delete (constraint conset)
@@ -280,12 +285,17 @@
;; Update the extrema.
,(ecase name
((conset-union)
- `(setf (conset-min conset-1)
- (min (conset-min conset-1)
- (conset-min conset-2))
- (conset-max conset-1)
- (max (conset-max conset-1)
- (conset-max conset-2))))
+ `(let ((empty1 (= (conset-min conset-1) (conset-max conset-1)))
+ (empty2 (= (conset-min conset-2) (conset-max conset-2))))
+ (cond (empty2) ; conset-2 is empty. Leave conset-1 bounds unchanged
+ (empty1 ; conset-1 is empty, inherit conset-2 bounds
+ (setf (conset-min conset-1) (conset-min conset-2)
+ (conset-max conset-1) (conset-max conset-2)))
+ (t ; Both nonempty
+ (setf (conset-min conset-1)
+ (min (conset-min conset-1) (conset-min conset-2))
+ (conset-max conset-1)
+ (max (conset-max conset-1) (conset-max conset-2)))))))
((conset-intersection)
`(let ((start (max (conset-min conset-1)
(conset-min conset-2)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL