mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-09 06:30:32 -07:00
Code Issues Projects Releases Packages Wiki Activity

loop: fix type declarations for iteration variables

Browse source 
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.
This commit is contained in:
Marius Gerbershagen 2019-01-25 23:30:35 +01:00
parent 0ad38e2a3d
commit 7a06d9795e
1 changed files with 16 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/lsp/loop.lsp
View file

@ -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))))