+;;; 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-continuation-use (set-value set)))
+ (() (and (combination-p set-use)
+ (fun-info-p (combination-kind set-use))
+ (eq (combination-fun-source-name set-use) '+))
+ :exit-if-null)
+ (+-args (basic-combination-args set-use))
+ (() (and (proper-list-of-length-p +-args 2 2)
+ (let ((first (principal-continuation-use
+ (first +-args))))
+ (and (ref-p first)
+ (eq (ref-leaf first) var))))
+ :exit-if-null)
+ (step-type (continuation-type (second +-args))))
+ (when (and (numeric-type-p initial-type)
+ (numeric-type-p step-type)
+ (eq (numeric-type-class initial-type)
+ (numeric-type-class step-type))
+ (eq (numeric-type-format initial-type)
+ (numeric-type-format step-type))
+ (eq (numeric-type-complexp initial-type)
+ (numeric-type-complexp step-type)))
+ (multiple-value-bind (low high)
+ (cond ((csubtypep step-type (specifier-type '(real 0 *)))
+ (values (numeric-type-low initial-type) nil))
+ ((csubtypep step-type (specifier-type '(real * 0)))
+ (values nil (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-continuation-end result))
+ (use (principal-continuation-use x)))
+ (when (and (ref-p use)
+ (set-p dest)
+ (eq (ref-leaf use)
+ (set-var dest)))
+ (reoptimize-continuation (set-value dest))))
+ (give-up-ir1-transform))
+