various: add infinityp trait

code/condition/utility.lisp

@@ -9,7 +9,9 @@
  :report (lambda (stream)
  (format stream "Recover using ~:[negative~;positive~] zero as the value."
  (plusp sign)))
- (quaviver:triple-float nil float-type 2 0 0 sign))))
+ (quaviver:triple-float nil float-type
+ (quaviver:primitive-base float-type)
+ 0 0 sign))))
 
 (defun floating-point-overflow (float-type sign operation &rest operands)
  (restart-case
@@ -19,18 +21,23 @@
  (recover ()
  :report (lambda (stream)
  (format stream
- #+clisp "Recover using the most ~:[negative~;positive~] floating point as the value."
- #-clisp "Recover using ~:[negative~;positive~] infinity as the value."
- (plusp sign)))
- #+clisp (if (minusp sign)
- (ecase float-type
- (short-float most-negative-short-float)
- (single-float most-negative-single-float)
- (double-float most-negative-double-float)
- (long-float most-negative-long-float))
- (ecase float-type
- (short-float most-positive-short-float)
- (single-float most-positive-single-float)
- (double-float most-positive-double-float)
- (long-float most-positive-long-float)))
- #-clisp (quaviver:triple-float nil float-type 2 0 :infinity sign))))
+ "Recover using~:[ the most~;~] ~:[negative~;positive~] ~:[floating point~;infinity~] as the value."
+ (quaviver:infinityp float-type)
+ (plusp sign)
+ (quaviver:infinityp float-type)))
+ (cond ((quaviver:infinityp float-type)
+ (quaviver:triple-float nil float-type
+ (quaviver:primitive-base float-type)
+ 0 :infinity sign))
+ ((minusp sign)
+ (ecase float-type
+ (short-float most-negative-short-float)
+ (single-float most-negative-single-float)
+ (double-float most-negative-double-float)
+ (long-float most-negative-long-float)))
+ (t
+ (ecase float-type
+ (short-float most-positive-short-float)
+ (single-float most-positive-single-float)
+ (double-float most-positive-double-float)
+ (long-float most-positive-long-float)))))))

code/interface.lisp

@@ -66,7 +66,9 @@
 
 (defgeneric non-number-p (type))
 
-(defgeneric internal-base (type))
+(defgeneric infinityp (type))
+
+(defgeneric primitive-base (type))
 
 (defgeneric exponent-bias (type)
  (:method (type)

code/packages.lisp

@@ -32,7 +32,8 @@
  #:hidden-bit-p
  #:subnormalp
  #:non-number-p
- #:internal-base
+ #:infinityp
+ #:primitive-base
  #:exponent-bias
  #:max-exponent
  #:min-exponent