- (((foreach fixnum bignum) ratio)
- (,op x (,ratio-arg2 (numerator y) (denominator y))))
- ((ratio integer)
- (,op (,ratio-arg1 (numerator x) (denominator x)) y))
- ((ratio ratio)
- (,op (* (numerator (truly-the ratio x))
- (denominator (truly-the ratio y)))
- (* (numerator (truly-the ratio y))
- (denominator (truly-the ratio x)))))
- ,@cases)))
-
-); Eval-When (Compile Eval)
-
-(two-arg-</> two-arg-< < floor ceiling
- ((fixnum bignum)
- (bignum-plus-p y))
- ((bignum fixnum)
- (not (bignum-plus-p x)))
- ((bignum bignum)
- (minusp (bignum-compare x y))))
-
-(two-arg-</> two-arg-> > ceiling floor
- ((fixnum bignum)
- (not (bignum-plus-p y)))
- ((bignum fixnum)
- (bignum-plus-p x))
- ((bignum bignum)
- (plusp (bignum-compare x y))))
+(macrolet ((def-two-arg-</> (name op ratio-arg1 ratio-arg2 &rest cases)
+ `(defun ,name (x y)
+ (number-dispatch ((x real) (y real))
+ (basic-compare
+ ,op
+ :infinite-x-finite-y
+ (,op x (coerce 0 '(dispatch-type x)))
+ :infinite-y-finite-x
+ (,op (coerce 0 '(dispatch-type y)) y))
+ (((foreach fixnum bignum) ratio)
+ (,op x (,ratio-arg2 (numerator y)
+ (denominator y))))
+ ((ratio integer)
+ (,op (,ratio-arg1 (numerator x)
+ (denominator x))
+ y))
+ ((ratio ratio)
+ (,op (* (numerator (truly-the ratio x))
+ (denominator (truly-the ratio y)))
+ (* (numerator (truly-the ratio y))
+ (denominator (truly-the ratio x)))))
+ ,@cases))))
+ (def-two-arg-</> two-arg-< < floor ceiling
+ ((fixnum bignum)
+ (bignum-plus-p y))
+ ((bignum fixnum)
+ (not (bignum-plus-p x)))
+ ((bignum bignum)
+ (minusp (bignum-compare x y))))
+ (def-two-arg-</> two-arg-> > ceiling floor
+ ((fixnum bignum)
+ (not (bignum-plus-p y)))
+ ((bignum fixnum)
+ (bignum-plus-p x))
+ ((bignum bignum)
+ (plusp (bignum-compare x y)))))