+;;; Iteration variable: exactly one SETQ of the form:
+;;;
+;;; (let ((var initial))
+;;; ...
+;;; (setq var (+ var step))
+;;; ...)
+(defun maybe-infer-iteration-var-type (var initial-type)
+ (binding* ((sets (lambda-var-sets var) :exit-if-null)
+ (set (first sets))
+ (() (null (rest sets)) :exit-if-null)
+ (set-use (principal-lvar-use (set-value set)))
+ (() (and (combination-p set-use)
+ (eq (combination-kind set-use) :known)
+ (fun-info-p (combination-fun-info set-use))
+ (not (node-to-be-deleted-p set-use))
+ (or (eq (combination-fun-source-name set-use) '+)
+ (eq (combination-fun-source-name set-use) '-)))
+ :exit-if-null)
+ (minusp (eq (combination-fun-source-name set-use) '-))
+ (+-args (basic-combination-args set-use))
+ (() (and (proper-list-of-length-p +-args 2 2)
+ (let ((first (principal-lvar-use
+ (first +-args))))
+ (and (ref-p first)
+ (eq (ref-leaf first) var))))
+ :exit-if-null)
+ (step-type (lvar-type (second +-args)))
+ (set-type (lvar-type (set-value set))))
+ (when (and (numeric-type-p initial-type)
+ (numeric-type-p step-type)
+ (or (numeric-type-equal initial-type step-type)
+ ;; Detect cases like (LOOP FOR 1.0 to 5.0 ...), where
+ ;; the initial and the step are of different types,
+ ;; and the step is less contagious.
+ (numeric-type-equal initial-type
+ (numeric-contagion initial-type
+ step-type))))
+ (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 #'< #'<=)))
+ (multiple-value-bind (low high)
+ (let ((step-type-non-negative (csubtypep step-type (specifier-type
+ '(real 0 *))))
+ (step-type-non-positive (csubtypep step-type (specifier-type
+ '(real * 0)))))
+ (cond ((or (and step-type-non-negative (not minusp))
+ (and step-type-non-positive minusp))
+ (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)))))
+ ((or (and step-type-non-positive (not minusp))
+ (and step-type-non-negative minusp))
+ (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))
+ (use (principal-lvar-use x)))
+ (when (and (ref-p use)
+ (set-p dest)
+ (eq (ref-leaf use)
+ (set-var dest)))
+ (reoptimize-lvar (set-value dest))))
+ (give-up-ir1-transform))
+