- ((and atype (not (values-types-equal-or-intersect atype
- type-returns)))
- (note-lossage
- "The result type from ~A:~% ~S~@
- conflicts with the definition's result type assertion:~% ~S"
- where (type-specifier type-returns) (type-specifier atype))
- nil)
- (*lossage-detected* nil)
- ((not really-assert) t)
- (t
- (when atype
- (assert-continuation-type (return-result return) atype
- (lexenv-policy (functional-lexenv functional))))
- (loop for var in vars and type in types do
- (cond ((basic-var-sets var)
- (when (and unwinnage-fun
- (not (csubtypep (leaf-type var) type)))
- (funcall unwinnage-fun
- "Assignment to argument: ~S~% ~
+ ((and dtype (not (values-types-equal-or-intersect dtype
+ type-returns)))
+ (note-lossage
+ "The result type from ~A:~% ~S~@
+ conflicts with the definition's result type:~% ~S"
+ where (type-specifier type-returns) (type-specifier dtype))
+ nil)
+ (*lossage-detected* nil)
+ ((not really-assert) t)
+ (t
+ (let ((policy (lexenv-policy (functional-lexenv functional))))
+ (when (policy policy (> type-check 0))
+ (assert-continuation-type (return-result return) type-returns
+ policy)))
+ (loop for var in vars and type in types do
+ (cond ((basic-var-sets var)
+ (when (and unwinnage-fun
+ (not (csubtypep (leaf-type var) type)))
+ (funcall unwinnage-fun
+ "Assignment to argument: ~S~% ~