0.8.3.74:

        * Change transformers for </>/>=/<= to work with unions of
          intervals;
        * CONSTRAIN-REF-TYPE: ignore constraints of form (EQL val
          <unreferenced-var>).

diff --git a/BUGS b/BUGS
index 3319a10..788da3e 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1257,13 +1257,4 @@ WORKAROUND:
   have made.
 
 292:
-  (COMPILE NIL
-           `(LAMBDA (C)
-              (DECLARE (TYPE (INTEGER -5945502333 12668542) C)
-                       (OPTIMIZE (SPEED 3)))
-              (LET ((V2 (* C 12)))
-                (- (MAX (IF (/= 109335113 V2) -26479 V2)
-                        (DEPOSIT-FIELD 311
-                                       (BYTE 14 28)
-                                       (MIN (MAX 521326 C) -51)))))))
-  causes compiler failure (reported by Paul Dietz).
+  (fixed in 0.8.3.74)

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 1037b72..8844aeb 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -354,7 +354,8 @@
                     (setq not-res (type-union not-res other-type)))
                   (let ((leaf-type (leaf-type leaf)))
                     (when (or (constant-p other)
-                              (and (csubtypep other-type leaf-type)
+                              (and (leaf-refs other) ; protect from deleted vars
+                                    (csubtypep other-type leaf-type)
                                    (not (type= other-type leaf-type))))
                       (change-ref-leaf ref other)
                       (when (constant-p other) (return)))))))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 0482f1b..cd22846 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -243,7 +243,8 @@
 
 (defun make-interval (&key low high)
   (labels ((normalize-bound (val)
-            (cond ((and (floatp val)
+            (cond #-sb-xc-host
+                   ((and (floatp val)
                         (float-infinity-p val))
                    ;; Handle infinities.
                    nil)
@@ -304,6 +305,23 @@
   (make-interval :low (numeric-type-low x)
                 :high (numeric-type-high x)))
 
+(defun type-approximate-interval (type)
+  (declare (type ctype type))
+  (let ((types (prepare-arg-for-derive-type type))
+        (result nil))
+    (dolist (type types)
+      (let ((type (if (member-type-p type)
+                      (convert-member-type type)
+                      type)))
+        (unless (numeric-type-p type)
+          (return-from type-approximate-interval nil))
+        (let ((interval (numeric-type->interval type)))
+          (setq result
+                (if result
+                    (interval-approximate-union result interval)
+                    interval)))))
+    result))
+
 (defun copy-interval-limit (limit)
   (if (numberp limit)
       limit
@@ -535,6 +553,16 @@
        (make-interval :low (select-bound x-lo y-lo #'< #'>)
                       :high (select-bound x-hi y-hi #'> #'<))))))
 
+;;; return the minimal interval, containing X and Y
+(defun interval-approximate-union (x y)
+  (cond ((interval-merge-pair x y))
+        ((interval-< x y)
+         (make-interval :low (copy-interval-limit (interval-low x))
+                        :high (copy-interval-limit (interval-high y))))
+        (t
+         (make-interval :low (copy-interval-limit (interval-low y))
+                        :high (copy-interval-limit (interval-high x))))))
+
 ;;; basic arithmetic operations on intervals. We probably should do
 ;;; true interval arithmetic here, but it's complicated because we
 ;;; have float and integer types and bounds can be open or closed.
@@ -2945,65 +2973,35 @@
 ;;; information. If X's high bound is < Y's low, then X < Y.
 ;;; Similarly, if X's low is >= to Y's high, the X >= Y (so return
 ;;; NIL). If not, at least make sure any constant arg is second.
-;;;
-;;; FIXME: Why should constant argument be second? It would be nice to
-;;; find out and explain.
-#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(defun ir1-transform-< (x y first second inverse)
-  (if (same-leaf-ref-p x y)
-      nil
-      (let* ((x-type (numeric-type-or-lose x))
-            (x-lo (numeric-type-low x-type))
-            (x-hi (numeric-type-high x-type))
-            (y-type (numeric-type-or-lose y))
-            (y-lo (numeric-type-low y-type))
-            (y-hi (numeric-type-high y-type)))
-       (cond ((and x-hi y-lo (< x-hi y-lo))
-              t)
-             ((and y-hi x-lo (>= x-lo y-hi))
-              nil)
-             ((and (constant-lvar-p first)
-                   (not (constant-lvar-p second)))
-              `(,inverse y x))
-             (t
-              (give-up-ir1-transform))))))
-#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(defun ir1-transform-< (x y first second inverse)
-  (if (same-leaf-ref-p x y)
-      nil
-      (let ((xi (numeric-type->interval (numeric-type-or-lose x)))
-           (yi (numeric-type->interval (numeric-type-or-lose y))))
-       (cond ((interval-< xi yi)
-              t)
-             ((interval->= xi yi)
-              nil)
-             ((and (constant-lvar-p first)
-                   (not (constant-lvar-p second)))
-              `(,inverse y x))
-             (t
-              (give-up-ir1-transform))))))
-
-(deftransform < ((x y) (integer integer) *)
-  (ir1-transform-< x y x y '>))
-
-(deftransform > ((x y) (integer integer) *)
-  (ir1-transform-< y x x y '<))
-
-#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform < ((x y) (float float) *)
-  (ir1-transform-< x y x y '>))
-
-#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.)
-(deftransform > ((x y) (float float) *)
-  (ir1-transform-< y x x y '<))
+(macrolet ((def (name reflexive-p surely-true surely-false)
+             `(deftransform ,name ((x y))
+                (if (same-leaf-ref-p x y)
+                    ,reflexive-p
+                    (let ((x (or (type-approximate-interval (lvar-type x))
+                                 (give-up-ir1-transform)))
+                          (y (or (type-approximate-interval (lvar-type y))
+                                 (give-up-ir1-transform))))
+                      (cond (,surely-true
+                             t)
+                            (,surely-false
+                             nil)
+                            ((and (constant-lvar-p x)
+                                  (not (constant-lvar-p y)))
+                             `(,',name y x))
+                            (t
+                             (give-up-ir1-transform))))))))
+  (def < nil (interval-< x y) (interval->= x y))
+  (def > nil (interval-< y x) (interval->= y x))
+  (def <= t (interval->= y x) (interval-< y x))
+  (def >= t (interval->= x y) (interval-< x y)))
 
 (defun ir1-transform-char< (x y first second inverse)
   (cond
     ((same-leaf-ref-p x y) nil)
     ;; If we had interval representation of character types, as we
     ;; might eventually have to to support 2^21 characters, then here
-    ;; we could do some compile-time computation as in IR1-TRANSFORM-<
-    ;; above.  -- CSR, 2003-07-01
+    ;; we could do some compile-time computation as in transforms for
+    ;; < above. -- CSR, 2003-07-01
     ((and (constant-lvar-p first)
          (not (constant-lvar-p second)))
      `(,inverse y x))

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 4c14ce6..194a4c6 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -234,5 +234,22 @@
                (MIN A (RETURN-FROM B8 C))))))
     C))
 
+;;; bug 292, reported by Paul Dietz
+(defun #:foo (C)
+  (DECLARE (TYPE (INTEGER -5945502333 12668542) C)
+           (OPTIMIZE (SPEED 3)))
+  (LET ((V2 (* C 12)))
+    (- (MAX (IF (/= 109335113 V2) -26479 V2)
+            (DEPOSIT-FIELD 311
+                           (BYTE 14 28)
+                           (MIN (MAX 521326 C) -51))))))
+
+;;; zombie variables, arising from constraints
+(defun #:foo (A B)
+  (DECLARE (TYPE (INTEGER -40945116 24028306) B)
+           (OPTIMIZE (SPEED 3)))
+  (LET ((V5 (MIN 31883 (LOGCOUNT A))))
+    (IF (/= B V5) (IF (EQL 122911784 V5) -43765 1487) B)))
+
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index 30555b3..169ad62 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.3.73"
+"0.8.3.74"