0.8.19.38:

        * Fix MISC.535: CONSTANT-LVAR-P looks through CASTs.
        * Workaround lack of recursion recognition in XC for
          PRINCIPAL-LVAR-USE.

diff --git a/NEWS b/NEWS
index e745572..69c0616 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -62,6 +62,8 @@ changes in sbcl-0.8.20 (0.9alpha.0?) relative to sbcl-0.8.19:
        with one-dimensional arrays with fill pointers.
     ** TYPE-OF failed on a complex with an integer realpart and a
        RATIO imagpart.
+    ** compiler failure during type inference for the code of form
+       (IF (EQL X (THE ...)) ...) (MISC.535).
 
 changes in sbcl-0.8.19 relative to sbcl-0.8.18:
   * new port: SBCL now works in native 64-bit mode on x86-64/Linux

diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS
index 53438ab..f17f2ee 100644 (file)
--- a/OPTIMIZATIONS
+++ b/OPTIMIZATIONS
@@ -187,9 +187,9 @@ stack-allocation of structures is impossible.
 --------------------------------------------------------------------------------
 #21
 (defun-with-dx foo ()
-  (let ((dx (list (list 1 2) (list 3 4)
+  (let ((dx (list (list 1 2) (list 3 4))))
     (declare (dynamic-extent dx))
-    ...)))))
+    ...))
 
 External list in DX is allocated on stack, but internal are not.
 --------------------------------------------------------------------------------

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 5e61da0..ebe39ca 100644 (file)
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -193,7 +193,7 @@
                     ((constant-lvar-p arg2)
                      (add-complement-constraints if 'eql var1
                                                  (ref-leaf
-                                                  (lvar-uses arg2))
+                                                  (principal-lvar-use arg2))
                                                  nil)))))
            ((< >)
             (let* ((arg1 (first args))

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index b62fb36..0efb8ae 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -63,10 +63,13 @@
         (list uses))))
 
 (defun principal-lvar-use (lvar)
-  (let ((use (lvar-uses lvar)))
-    (if (cast-p use)
-        (principal-lvar-use (cast-value use))
-        use)))
+  (labels ((plu (lvar)
+             (declare (type lvar lvar))
+             (let ((use (lvar-uses lvar)))
+               (if (cast-p use)
+                   (plu (cast-value use))
+                   use))))
+    (plu lvar)))
 
 ;;; Update lvar use information so that NODE is no longer a use of its
 ;;; LVAR.

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 3381087..f4bc19c 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1716,3 +1716,15 @@
            (let ((b (make-array 64 :element-type 'bit :initial-element 0)))
              (setf (sbit b 63) 1)
              b)))))
+
+;;; MISC.535: compiler failure
+(let ((c0 #c(4196.088977268509d0 -15943.3603515625d0)))
+    (assert (not (funcall
+     (compile
+      nil
+      `(lambda (p1 p2)
+        (declare (optimize speed (safety 1))
+                 (type (eql ,c0) p1)
+                 (type number p2))
+        (eql (the (complex double-float) p1) p2)))
+     c0 #c(12 612/979)))))

diff --git a/version.lisp-expr b/version.lisp-expr
index c9fe506..9effc16 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.19.37"
+"0.8.19.38"