mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-24 13:31:58 -08:00
Code Issues Projects Releases Packages Wiki Activity

loop: fix type declarations for nil-initialized variables

Browse source 
In expansions such as
(loop for i of-type some-type in some-list ...)
we were declaring the type of i to be some-type instead of the
correct (or null some-type).
This commit is contained in:
Marius Gerbershagen 2019-03-23 16:35:29 +01:00
parent f7cd2b8775
commit 8bc2f8a983
1 changed files with 14 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/lsp/loop.lsp
View file

@ -927,11 +927,11 @@ collected result will be returned as the value of the LOOP."
(loop-error "Duplicated variable ~S in LOOP parallel binding." name)))
(unless (symbolp name)
(loop-error "Bad variable ~S somewhere in LOOP." name))
(loop-declare-variable name dtype)
;; We use ASSOC on this list to check for duplications (above),
;; so don't optimize out this list:
(push (list name (or initialization (loop-typed-init dtype)))
*loop-variables*))
(let ((init (or initialization (loop-typed-init dtype))))
(loop-declare-variable name dtype init)
;; We use ASSOC on this list to check for duplications (above),
;; so don't optimize out this list:
(push (list name init) *loop-variables*)))
(initialization
(cond (*loop-destructuring-hooks*
(loop-declare-variable name dtype)
@ -957,11 +957,15 @@ collected result will be returned as the value of the LOOP."
(loop-make-variable name initialization dtype t))
(defun loop-declare-variable (name dtype)
(defun loop-declare-variable (name dtype &optional (initialization nil initialization-p))
(declare (si::c-local))
(cond ((or (null name) (null dtype) (eq dtype t)) nil)
((symbolp name)
(unless (or (eq dtype t) (member (truly-the symbol name) *loop-nodeclare*))
(when (and initialization-p (constantp initialization))
(let ((init-type (type-of initialization)))
(unless (subtypep init-type dtype)
(setf dtype `(or ,dtype ,init-type)))))
;; Allow redeclaration of a variable. This can be used by
;; the loop constructors to make the type more and more
;; precise as we add keywords
@ -975,10 +979,12 @@ collected result will be returned as the value of the LOOP."
(setf (second previous) dtype)
(push `(type ,dtype ,name) *loop-declarations*)))))
((consp name)
;; to be on the safe side, we always assume that
;; destructuring variable bindings initialize to nil
(cond ((consp dtype)
(loop-declare-variable (car name) (car dtype))
(loop-declare-variable (car name) (car dtype) nil)
(loop-declare-variable (cdr name) (cdr dtype)))
(t (loop-declare-variable (car name) dtype)
(t (loop-declare-variable (car name) dtype nil)
(loop-declare-variable (cdr name) dtype))))
(t (error "Invalid LOOP variable passed in: ~S." name))))