Commit 8bc2f8a9 authored by Marius Gerbershagen's avatar Marius Gerbershagen

loop: fix type declarations for nil-initialized variables

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).
parent f7cd2b87
......@@ -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))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment