+
+;;; If CONT is an argument of a function, return a type which the
+;;; function checks CONT for.
+#!-sb-fluid (declaim (inline continuation-externally-checkable-type))
+(defun continuation-externally-checkable-type (cont)
+ (or (continuation-%externally-checkable-type cont)
+ (%continuation-%externally-checkable-type cont)))
+(defun %continuation-%externally-checkable-type (cont)
+ (declare (type continuation cont))
+ (let ((dest (continuation-dest cont)))
+ (if (not (and dest (combination-p dest)))
+ ;; TODO: MV-COMBINATION
+ (setf (continuation-%externally-checkable-type cont) *wild-type*)
+ (let* ((fun (combination-fun dest))
+ (args (combination-args dest))
+ (fun-type (continuation-type fun)))
+ (setf (continuation-%externally-checkable-type fun) *wild-type*)
+ (if (or (not (fun-type-p fun-type))
+ ;; FUN-TYPE might be (AND FUNCTION (SATISFIES ...)).
+ (fun-type-wild-args fun-type))
+ (progn (dolist (arg args)
+ (when arg
+ (setf (continuation-%externally-checkable-type arg)
+ *wild-type*)))
+ *wild-type*)
+ (let* ((arg-types (append (fun-type-required fun-type)
+ (fun-type-optional fun-type)
+ (let ((rest (list (or (fun-type-rest fun-type)
+ *wild-type*))))
+ (setf (cdr rest) rest)))))
+ ;; TODO: &KEY
+ (loop
+ for arg of-type continuation in args
+ and type of-type ctype in arg-types
+ do (when arg
+ (setf (continuation-%externally-checkable-type arg)
+ type)))
+ (continuation-%externally-checkable-type cont)))))))