- (if (and (csubtypep x-type (specifier-type 'number))
- (csubtypep y-type (specifier-type 'number)))
- (cond ((or (and (csubtypep x-type (specifier-type 'float))
- (csubtypep y-type (specifier-type 'float)))
- (and (csubtypep x-type (specifier-type '(complex float)))
- (csubtypep y-type (specifier-type '(complex float)))))
- ;; They are both floats. Leave as = so that -0.0 is
- ;; handled correctly.
- (give-up-ir1-transform))
- ((or (and (csubtypep x-type (specifier-type 'rational))
- (csubtypep y-type (specifier-type 'rational)))
- (and (csubtypep x-type
- (specifier-type '(complex rational)))
- (csubtypep y-type
- (specifier-type '(complex rational)))))
- ;; They are both rationals and complexp is the same.
- ;; Convert to EQL.
- '(eql x y))
- (t
- (give-up-ir1-transform
- "The operands might not be the same type.")))
- (give-up-ir1-transform
- "The operands might not be the same type."))))
-
-;;; If LVAR's type is a numeric type, then return the type, otherwise
-;;; GIVE-UP-IR1-TRANSFORM.
-(defun numeric-type-or-lose (lvar)
- (declare (type lvar lvar))
- (let ((res (lvar-type lvar)))
- (unless (numeric-type-p res) (give-up-ir1-transform))
- res))
+ (cond ((or (and (csubtypep x-type (specifier-type 'float))
+ (csubtypep y-type (specifier-type 'float)))
+ (and (csubtypep x-type (specifier-type '(complex float)))
+ (csubtypep y-type (specifier-type '(complex float)))))
+ ;; They are both floats. Leave as = so that -0.0 is
+ ;; handled correctly.
+ (give-up-ir1-transform))
+ ((or (and (csubtypep x-type (specifier-type 'rational))
+ (csubtypep y-type (specifier-type 'rational)))
+ (and (csubtypep x-type
+ (specifier-type '(complex rational)))
+ (csubtypep y-type
+ (specifier-type '(complex rational)))))
+ ;; They are both rationals and complexp is the same.
+ ;; Convert to EQL.
+ '(eql x y))
+ (t
+ (give-up-ir1-transform
+ "The operands might not be the same type.")))))
+
+(defun maybe-float-lvar-p (lvar)
+ (neq *empty-type* (type-intersection (specifier-type 'float)
+ (lvar-type lvar))))
+
+(flet ((maybe-invert (node op inverted x y)
+ ;; Don't invert if either argument can be a float (NaNs)
+ (cond
+ ((or (maybe-float-lvar-p x) (maybe-float-lvar-p y))
+ (delay-ir1-transform node :constraint)
+ `(or (,op x y) (= x y)))
+ (t
+ `(if (,inverted x y) nil t)))))
+ (deftransform >= ((x y) (number number) * :node node)
+ "invert or open code"
+ (maybe-invert node '> '< x y))
+ (deftransform <= ((x y) (number number) * :node node)
+ "invert or open code"
+ (maybe-invert node '< '> x y)))