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