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