+
+(defun scaled-epsilon (float &optional (operation '+))
+ "Return the smallest number that would return a value different from
+ FLOAT if OPERATION were applied to FLOAT and this number. OPERATION
+ should be either + or -, and defauls to +."
+ (multiple-value-bind (significand exponent)
+ (decode-float float)
+ (multiple-value-bind (1.0-significand 1.0-exponent)
+ (decode-float (float 1.0 float))
+ (if (and (eq operation '-)
+ (= significand 1.0-significand))
+ (scale-float (typecase float
+ (short-float short-float-negative-epsilon)
+ (single-float single-float-negative-epsilon)
+ (double-float double-float-negative-epsilon)
+ (long-float long-float-negative-epsilon))
+ (- exponent 1.0-exponent))
+ (scale-float (typecase float
+ (short-float short-float-epsilon)
+ (single-float single-float-epsilon)
+ (double-float double-float-epsilon)
+ (long-float long-float-epsilon))
+ (- exponent 1.0-exponent))))))