+
+(defun assert-global-function-definition-type (name fun)
+ (declare (type functional fun))
+ (let ((type (info :function :type name))
+ (where (info :function :where-from name)))
+ (when (eq where :declared)
+ (setf (leaf-type fun) type)
+ (assert-definition-type fun type
+ :unwinnage-fun #'compiler-note
+ :where "proclamation"))))
+\f
+;;;; FIXME: Move to some other file.
+(defun check-catch-tag-type (tag)
+ (declare (type continuation tag))
+ (let ((ctype (continuation-type tag)))
+ (when (csubtypep ctype (specifier-type '(or number character)))
+ (compiler-style-warn "~@<using ~S of type ~S as a catch tag (which ~
+ tends to be unportable because THROW and CATCH ~
+ use EQ comparison)~@:>"
+ (continuation-source tag)
+ (type-specifier (continuation-type tag))))))