Optimize (typep x '(or bignum float))

src/code/room.lisp

@@ -1058,20 +1058,8 @@ We could try a few things to mitigate this:
  ;; do (,functoid (%code-entry-point ,obj .i.) ,@more)))
  ;; and/or visit the slots of each simple-fun but not the fun per se.
  )
- ,.(make-case '(or float #+sb-simd-pack simd-pack
+ ,.(make-case '(or float bignum #+sb-simd-pack simd-pack
  system-area-pointer)) ; nothing to do
- ;; FIXME: (TYPEP x 'BIGNUM) is correctly implemented as a test of
- ;; lowtag and widetag, but (TYPEP x '(OR BIGNUM ANYTHING-ELSE))
- ;; is "mildly incorrectly" implemented as
- ;; `(OR (INTEGER * ,(1- most-negative-fixnum))
- ;; (INTEGER (1+ most-positive-fixnum))
- ;; anything-else)
- ;; And this has busted semantics for our purposes here.
- ;; Uncanonical bignums (which would normalize to a fixnum)
- ;; do not satisy the range test.
- ;; So in order to avoid reaching the T case, we have to split out
- ;; BIGNUM all by itself, which becomes a pointer test.
- ,.(make-case 'bignum)
  ,.(make-case 'weak-pointer `(weak-pointer-value ,obj))
  ,.(make-case 'ratio `(%numerator ,obj) `(%denominator ,obj))
  ;; Use the non-primitive slot readers because we don't know

src/compiler/generic/vm-type.lisp

@@ -286,6 +286,15 @@
  (unless (and info (sb!c::fun-info-templates info))
  (return-from widetags-from-union-type (values nil types))))
  (let (widetags remainder)
+ ;; A little optimization for (OR BIGNUM other). Without this, there would
+ ;; be a two-sided GENERIC-{<,>} test plus whatever test(s) "other" entails.
+ (let ((neg-bignum (specifier-type `(integer * (,most-negative-fixnum))))
+ (pos-bignum (specifier-type `(integer (,most-positive-fixnum) *))))
+ (when (and (member neg-bignum types :test #'type=)
+ (member pos-bignum types :test #'type=))
+ (push sb!vm:bignum-widetag widetags)
+ (setf types (remove-if (lambda (x) (or (type= x neg-bignum) (type= x pos-bignum)))
+ types))))
  (dolist (x types)
  (let ((adjunct
  (cond

tests/compiler-2.pure.lisp

@@ -1425,3 +1425,8 @@
  ()
  `(lambda (x y)
  (write-sequence nil (the standard-object x) y nil))))
+
+(with-test (:name :or-bignum-single-float-no-warn)
+ (checked-compile
+ '(lambda (x) (declare (optimize speed)) (typep x '(or bignum single-float)))
+ :allow-notes nil))