- (flet ((delete-cast ()
- (let ((cont (node-cont cast)))
- (delete-filter cast cont value)
- (reoptimize-continuation cont)
- (when (continuation-single-value-p cont)
- (note-single-valuified-continuation cont))
- (when (not (continuation-dest cont))
- (reoptimize-continuation-uses cont)))))
- (cond
- ((and (not do-not-optimize)
- (values-subtypep value-type
- (cast-asserted-type cast)))
- (delete-cast)
- (return-from ir1-optimize-cast t))
- ((and (cast-%type-check cast)
- (values-subtypep value-type
- (cast-type-to-check cast)))
- (setf (cast-%type-check cast) nil)))))
+ (when (and (not do-not-optimize)
+ (values-subtypep value-type
+ (cast-asserted-type cast)))
+ (delete-filter cast cont value)
+ (reoptimize-continuation cont)
+ (when (continuation-single-value-p cont)
+ (note-single-valuified-continuation cont))
+ (when (not dest)
+ (reoptimize-continuation-uses cont))
+ (return-from ir1-optimize-cast t))
+
+ (when (and (not do-not-optimize)
+ (not (continuation-use value))
+ dest)
+ (collect ((merges))
+ (do-uses (use value)
+ (when (and (values-subtypep (node-derived-type use) atype)
+ (immediately-used-p value use))
+ (ensure-block-start cont)
+ (delete-continuation-use use)
+ (add-continuation-use use cont)
+ (unlink-blocks (node-block use) (node-block cast))
+ (link-blocks (node-block use) (continuation-block cont))
+ (when (and (return-p dest)
+ (basic-combination-p use)
+ (eq (basic-combination-kind use) :local))
+ (merges use))))
+ (dolist (use (merges))
+ (merge-tail-sets use))))
+
+ (when (and (cast-%type-check cast)
+ (values-subtypep value-type
+ (cast-type-to-check cast)))
+ (setf (cast-%type-check cast) nil)))