From 8fa5c056f5e1898d2bc5688aaf35105d8de112c0 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Tue, 15 Nov 2005 04:13:41 +0000 Subject: [PATCH] 0.9.6.43: Improve loop index variable detection: * Allow the initial value and the step to be of different types, as long as the initial value is more contagious (e.g (LOOP FOR I FROM 1.0 TO 5.0 ...)) * Allow modification to the index variable with -, not just + (e.g (LOOP REPEAT 5 ...)) --- src/compiler/ir1opt.lisp | 51 +++++++++++++++++++++++++++++----------------- version.lisp-expr | 2 +- 2 files changed, 33 insertions(+), 20 deletions(-) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index f2152d3..1102112 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -1226,20 +1226,28 @@ (eq (combination-kind set-use) :known) (fun-info-p (combination-fun-info set-use)) (not (node-to-be-deleted-p set-use)) - (eq (combination-fun-source-name set-use) '+)) - :exit-if-null) + (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) + :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) - (numeric-type-equal initial-type 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) @@ -1256,22 +1264,27 @@ (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)) - (min* (numeric-type-low initial-type) - (numeric-type-low set-type))) - (numeric-type-high initial-type))) - (t - (values nil nil))) + (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 diff --git a/version.lisp-expr b/version.lisp-expr index 0840280..1982f36 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.6.42" +"0.9.6.43" -- 1.7.10.4