From 8bc2f8a983bf0e18d525a4d7439768b0f57e26a0 Mon Sep 17 00:00:00 2001 From: Marius Gerbershagen Date: Sat, 23 Mar 2019 16:35:29 +0100 Subject: [PATCH] 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). --- src/lsp/loop.lsp | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/lsp/loop.lsp b/src/lsp/loop.lsp index 89ad0249a..11c498b91 100644 --- a/src/lsp/loop.lsp +++ b/src/lsp/loop.lsp @@ -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))))