0.9.1.36:

[sbcl.git] / src / compiler / ir1opt.lisp

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 731ccbf..34117f5 100644 (file)
--- 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))