+;;; Merge CASTs with preceding/following nodes.
+(defun ir1-merge-casts (component)
+ (do-blocks-backwards (block component)
+ (do-nodes-backwards (node lvar block)
+ (let ((dest (when lvar (lvar-dest lvar))))
+ (cond ((and (cast-p dest)
+ (not (cast-type-check dest))
+ (immediately-used-p lvar node))
+ (let ((dtype (node-derived-type node))
+ (atype (node-derived-type dest)))
+ (when (values-types-equal-or-intersect
+ dtype atype)
+ ;; FIXME: We do not perform pathwise CAST->type-error
+ ;; conversion, and type errors can later cause
+ ;; backend failures. On the other hand, this version
+ ;; produces less efficient code.
+ ;;
+ ;; This is sorta DERIVE-NODE-TYPE, but does not try
+ ;; to optimize the node.
+ (setf (node-derived-type node)
+ (values-type-intersection dtype atype)))))
+ ((and (cast-p node)
+ (eq (cast-type-check node) :external))
+ (aver (basic-combination-p dest))
+ (delete-filter node lvar (cast-value node))))))))
+