From 7a06d9795e9f2e0954ccc8ec9aaa9653252c5c2b Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Fri, 25 Jan 2019 23:30:35 +0100
Subject: [PATCH] loop: fix type declarations for iteration variables

    We only need to consider the types of start and step variables,
    since the limit value is never actually assigned to the iteration
    variable.
    Fixes #455.
---
 src/lsp/loop.lsp | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/src/lsp/loop.lsp b/src/lsp/loop.lsp
index 1fe01a345..89ad0249a 100644
--- a/src/lsp/loop.lsp
+++ b/src/lsp/loop.lsp
@@ -1256,7 +1256,7 @@ collected result will be returned as the value of the LOOP."
       (setq pseudo-steps (nconc pseudo-steps (copy-list (car (setq tem (cdr tem))))))
       (setq tem (cdr tem))
       (when *loop-emitted-body*
-        (loop-error "Iteration in LOOP follows body code. This error is typicall caused
+        (loop-error "Iteration in LOOP follows body code. This error is typically caused
 by a WHILE, UNTIL or similar condition placed in between FOR, AS, and similar iterations.
 Note that this is not a valid ANSI code."))
       (unless tem (setq tem data))
@@ -1684,22 +1684,32 @@ Note that this is not a valid ANSI code."))
      (when step-hack
        (setq step-hack `(,variable ,step-hack)))
      (let ((first-test test) (remaining-tests test))
-       (when (and stepby-constantp start-constantp limit-constantp)
+       (when (and stepby-constantp start-constantp)
          ;; We can make the number type more precise when we know the
          ;; start, end and step values.
-         (let ((new-type (typecase (+ start-value stepby limit-value)
+         (let ((new-type (typecase (+ start-value stepby)
                            (integer (if (and (fixnump start-value)
-                                             (fixnump limit-value))
+                                             limit-constantp
+                                             (< limit-value most-positive-fixnum)
+                                             (> limit-value most-negative-fixnum))
                                         'fixnum
-                                        indexv-type))
+                                        'integer))
                            (single-float 'single-float)
                            (double-float 'double-float)
                            (long-float 'long-float)
                            (short-float 'short-float)
                            (t indexv-type))))
+           (unless (subtypep (type-of start-value) new-type)
+             ;; The start type may not be a subtype of the type during
+             ;; iteration. Happens e.g. when stepping a fixnum start
+             ;; value by a float.
+             (setf new-type `(or ,(type-of start-value) ,new-type)))
            (unless (subtypep indexv-type new-type)
              (loop-declare-variable indexv new-type)))
-         (when (setq first-test (funcall (symbol-function testfn) start-value limit-value))
+         (when (and limit-constantp
+                    (setq first-test (funcall (symbol-function testfn)
+                                              start-value
+                                              limit-value)))
            (setq remaining-tests t)))
        `(() (,indexv ,step) ,remaining-tests ,step-hack
          () () ,first-test ,step-hack))))