From 323d8b15f3343a9dbcd8e9f16e496957cb70f7b6 Mon Sep 17 00:00:00 2001
From: Alexey Dejneka <adejneka@comail.ru>
Date: Sat, 7 May 2005 06:04:36 +0000
Subject: [PATCH] 0.9.0.23:         * Fix compiler failure reported by Alan
 Shields:           MAYBE-INFER-ITERATION-VAR-TYPE failed to
 deal with types           (REAL * (x)).

---
 NEWS                           |    4 ++-
 src/compiler/ir1opt.lisp       |   61 +++++++++++++++++++++++-----------------
 tests/compiler.pure-cload.lisp |    5 ++++
 version.lisp-expr              |    2 +-
 4 files changed, 44 insertions(+), 28 deletions(-)

diff --git a/NEWS b/NEWS
index 3ba9354..8ab65ac 100644
--- a/NEWS
+++ b/NEWS
@@ -2,7 +2,9 @@ changes in sbcl-0.9.1 relative to sbcl-0.9.0:
   * fixed cross-compiler leakages that prevented building a 32-bit
     target with a 64-bit host compiler.
   * fixed a bug in CLOSE :ABORT T: no longer attempts to remove files
-    opened with :IF-EXISTS :OVERWRITE
+    opened with :IF-EXISTS :OVERWRITE.
+  * bug fix: iteration variable type inferrer failed to deal with open
+    intervals. (reported by Alan Shields)
   * compiled code is not steppable if COMPILATION-SPEED >= DEBUG.
   * contrib improvement: implement SB-POSIX:MKSTEMP (Yannick Gingras)
   * optimization: There's now a fast-path for fixnum arguments in the
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 731ccbf..34117f5 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1210,33 +1210,42 @@
     (when (and (numeric-type-p initial-type)
                (numeric-type-p step-type)
                (numeric-type-equal initial-type step-type))
-      (multiple-value-bind (low high)
-          (cond ((csubtypep step-type (specifier-type '(real 0 *)))
-                 (values (numeric-type-low initial-type)
-                         (when (and (numeric-type-p set-type)
-                                    (numeric-type-equal set-type initial-type))
-                           (flet ((max* (i j)
-                                    (cond ((eq i nil) nil)
-                                          ((eq j nil) nil)
-                                          (t (max i j)))))
+      (labels ((leftmost (x y cmp cmp=)
+                 (cond ((eq x nil) nil)
+                       ((eq y nil) nil)
+                       ((listp x)
+                        (let ((x1 (first x)))
+                          (cond ((listp y)
+                                 (let ((y1 (first y)))
+                                   (if (funcall cmp x1 y1) x y)))
+                                (t
+                                 (if (funcall cmp x1 y) x y)))))
+                       ((listp y)
+                        (let ((y1 (first y)))
+                          (if (funcall cmp= x y1) x y)))
+                       (t (if (funcall cmp x y) x y))))
+               (max* (x y) (leftmost x y #'> #'>=))
+               (min* (x y) (leftmost x y #'< #'<=)))
+        (declare (inline compare))
+        (multiple-value-bind (low high)
+            (cond ((csubtypep step-type (specifier-type '(real 0 *)))
+                   (values (numeric-type-low initial-type)
+                           (when (and (numeric-type-p set-type)
+                                      (numeric-type-equal set-type initial-type))
                              (max* (numeric-type-high initial-type)
-                                   (numeric-type-high set-type))))))
-                ((csubtypep step-type (specifier-type '(real * 0)))
-                 (values (when (and (numeric-type-p set-type)
-                                    (numeric-type-equal set-type initial-type))
-                           (flet ((min* (i j)
-                                    (cond ((eq i nil) nil)
-                                          ((eq j nil) nil)
-                                          (t (min i j)))))
-                           (min* (numeric-type-low initial-type)
-                                 (numeric-type-low set-type))))
-                         (numeric-type-high initial-type)))
-                (t
-                 (values nil nil)))
-        (modified-numeric-type initial-type
-                               :low low
-                               :high high
-                               :enumerable nil)))))
+                                   (numeric-type-high set-type)))))
+                  ((csubtypep step-type (specifier-type '(real * 0)))
+                   (values (when (and (numeric-type-p set-type)
+                                      (numeric-type-equal set-type initial-type))
+                             (min* (numeric-type-low initial-type)
+                                   (numeric-type-low set-type)))
+                           (numeric-type-high initial-type)))
+                  (t
+                   (values nil nil)))
+          (modified-numeric-type initial-type
+                                 :low low
+                                 :high high
+                                 :enumerable nil))))))
 (deftransform + ((x y) * * :result result)
   "check for iteration variable reoptimization"
   (let ((dest (principal-lvar-end result))
diff --git a/tests/compiler.pure-cload.lisp b/tests/compiler.pure-cload.lisp
index d5eede6..04eb4d7 100644
--- a/tests/compiler.pure-cload.lisp
+++ b/tests/compiler.pure-cload.lisp
@@ -157,3 +157,8 @@
                  (funcall test-pred func func)
                  (delete func (list func))))))
   (assert (equal '(t t nil) (funcall (eval #'test-case) #'eq 3))))
+
+;;; compiler failure reported by Alan Shields:
+;;; MAYBE-INFER-ITERATION-VAR-TYPE did not deal with types (REAL * (n)).
+(let ((s (loop for x from (- pi) below (floor (* 2 pi)) by (/ pi 75) count t)))
+  (assert (= s 219)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 0f2355c..ef49dbc 100644
--- 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.9.0.22"
+"0.9.0.23"
-- 
1.7.10.4