diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp index 0efa59205dd62c7c81ab62d64aeaee0d54159b9e..f16aaa98e5f53330d789ff94f86e7cf839af2ec2 100644 --- a/compiler/ir1tran.lisp +++ b/compiler/ir1tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.54 1991/10/20 14:36:34 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.55 1991/10/23 12:50:11 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2498,19 +2498,27 @@ ;;; Process-1-Ftype-Proclamation -- Internal ;;; -;;; For now, just update the type of any old var and remove the name from -;;; the list of undefined functions. Eventually we whould check for -;;; incompatible redefinition. +;;; Update function type info cached in *free-functions*. If: +;;; -- there is a GLOBAL-VAR, then just update the type and remove the name +;;; from the list of undefined functions. Someday we should check for +;;; incompatible redeclaration. +;;; -- there is a FUNCTIONAL, then apply the type assertion to that function. +;;; This will only happen during block compilation. ;;; (defun process-1-ftype-proclamation (name type) (declare (type function-type type)) (let ((var (gethash (define-function-name name) *free-functions*))) - (when var - (let ((new (copy-global-var var)) - (name (leaf-name var))) - (setf (leaf-type new) type) - (setf (leaf-where-from new) :declared) - (setf (gethash name *free-functions*) new)))) + (etypecase var + (null) + (global-var + (let ((new (copy-global-var var)) + (name (leaf-name var))) + (setf (leaf-type new) type) + (setf (leaf-where-from new) :declared) + (setf (gethash name *free-functions*) new))) + (functional + (assert-definition-type var type :warning-function #'compiler-note + :where "this declaration")))) (undefined-value)) @@ -3260,7 +3268,9 @@ (ir1-attributep (function-info-attributes function-info) explicit-check)))) - :where (if for-real "declaration" "definition")))) + :where (if for-real + "previous declaration" + "previous definition")))) (ir1-convert start cont