assert-lvar-type: better fixed point detection.

The derived type of an LVAR can be an intersection type, even if it's
already asserted with a CAST, which will make the subtypep check
unsuccessful. Find the CAST that uses that LVAR and see if its
asserted-type is a subtype.

Fixes lp#1769698

src/compiler/ir1opt.lisp

@@ -311,14 +311,29 @@
  (reoptimize-lvar lvar)))))
  (values))
 
+
+(defun type-asserted-p (lvar type)
+ (or (values-subtypep (lvar-derived-type lvar) type)
+ ;; Just doing values-subtypep is not enough since it may be an
+ ;; intersection of types. Need to see if there's a cast that
+ ;; actually checks that particular type.
+ (do-uses (node lvar t)
+ (unless
+ (typecase node
+ (cast
+ (values-subtypep (coerce-to-values (cast-asserted-type node)) type))
+ (t
+ (values-subtypep (node-derived-type node) type)))
+ (return)))))
+
 ;;; This is similar to DERIVE-NODE-TYPE, but asserts that it is an
 ;;; error for LVAR's value not to be TYPEP to TYPE. We implement it
 ;;; splitting off DEST a new CAST node; old LVAR will deliver values
 ;;; to CAST. If we improve the assertion, we set TYPE-CHECK to
 ;;; guarantee that the new assertion will be checked.
 (defun assert-lvar-type (lvar type policy &optional context)
  (declare (type lvar lvar) (type ctype type))
- (unless (values-subtypep (lvar-derived-type lvar) type)
+ (unless (type-asserted-p lvar type)
  (let ((internal-lvar (make-lvar))
  (dest (lvar-dest lvar)))
  (substitute-lvar internal-lvar lvar)

tests/compiler-2.pure.lisp

@@ -1419,3 +1419,9 @@
  (ash (the (satisfies eval) n)
  (the (integer * 0) s)))
  ((1234 -4) 77)))
+
+(with-test (:name :assert-lvar-type-intersection)
+ (checked-compile-and-assert
+ ()
+ `(lambda (x y)
+ (write-sequence nil (the standard-object x) y nil))))