GitLab

at 2018-02-04T08:16:35-08:00

Fix typo.  double-double-float is in the kernel package

Be more careful in computing the decode-float bounds

If 0 is the lower bound then the smallest exponent is not for 0, but
for the least positive float because of denormals.

Also handle exclusive bounds.

Add more tests decode-float.

   (labels

       ((calc-exp (x)

 	 (when x

-	   (nth-value 1 (decode-float x))))

-       (min-exp ()

-	 ;; Use decode-float on the least positive float of the

-	 ;; appropriate type to find the min exponent.  If we don't

-	 ;; know the actual number format, use double, which has the

-	 ;; widest range (including double-double-float).

-	 (calc-exp (if (eq 'single-float (numeric-type-format arg))

-		       least-positive-single-float

-		       least-positive-double-float)))

-       (max-exp ()

+	   (bound-func #'(lambda (arg)

+			   (nth-value 1 (decode-float arg)))

+		       x)))

+       (min-exp (interval)

+	 ;; (decode-float 0d0) returns an exponent of -1022.  But

+	 ;; (decode-float least-positive-double-float returns -1073.

+	 ;; Hence, if the low value is less than this, we need to

+	 ;; return the exponent of the least positive number.

+	 (let ((least (if (eq 'single-float (numeric-type-format arg))

+			  least-positive-single-float

+			  least-positive-double-float)))

+	   (if (or (interval-contains-p 0 interval)

+		   (interval-contains-p least interval))

+	     (calc-exp least)

+	     (calc-exp (bound-value (interval-low interval))))))

+       (max-exp (interval)

 	 ;; Use decode-float on the most postive number of the

 	 ;; appropriate type to find the max exponent.  If we don't

 	 ;; know the actual number format, use double, which has the

 	 ;; widest range (including double-double-float).

-	 (calc-exp (if (eq 'single-float (numeric-type-format arg))

-		       most-positive-single-float

-		       most-positive-double-float))))

-    (let* ((interval (interval-func #'calc-exp

-				    (interval-abs (numeric-type->interval arg))))

-	   (lo (or (interval-low interval)

-		   (min-exp)))

-	   (hi (or (interval-high interval)

-		   (max-exp))))

+	 (or (calc-exp (bound-value (interval-high interval)))

+	     (calc-exp (if (eq 'single-float (numeric-type-format arg))

+			   most-positive-single-float

+			   most-positive-double-float)))))

+    (let* ((interval (interval-abs (numeric-type->interval arg)))

+	   (lo (min-exp interval))

+	   (hi (max-exp interval)))

       (specifier-type `(integer ,(or lo '*) ,(or hi '*))))))

 (defun decode-float-sign-derive-type-aux (arg)

   #+double-double

   (assert-equalp (c::specifier-type '(integer -1073 1024))

 		 (c::decode-float-exp-derive-type-aux

-		  (c::specifier-type 'double-double-float)))

+		  (c::specifier-type 'kernel:double-double-float)))

   (assert-equalp (c::specifier-type '(integer 2 8))

 		 (c::decode-float-exp-derive-type-aux

 		  (c::specifier-type '(double-float 2d0 128d0)))))

 			    (declare (type (double-float -2d0 0d0) z))

 			    (nth-value 2 (decode-float z))))))

     (assert-equal -1d0 (funcall f -1d0))))

+

+(define-test issue.59.1-double

+  (:tag :issues)

+  (dolist (entry '(((-2d0 2d0) (-1073 2))

+		   ((-2d0 0d0) (-1073 2))

+		   ((0d0 2d0) (-1073 2))

+		   ((1d0 4d0) (1 3))

+		   ((-4d0 -1d0) (1 3))

+		   (((0d0) (10d0)) (-1073 4))

+		   ((-2f0 2f0) (-148 2))

+		   ((-2f0 0f0) (-148 2))

+		   ((0f0 2f0) (-148 2))

+		   ((1f0 4f0) (1 3))

+		   ((-4f0 -1f0) (1 3))

+		   ((0f0) (10f0)) (-148 4)))

+    (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))

+	entry

+      (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))

+		     (c::decode-float-exp-derive-type-aux

+		      (c::specifier-type `(double-float ,arg-lo ,arg-hi)))))))

+

+(define-test issue.59.1-double

+  (:tag :issues)

+  (dolist (entry '(((-2d0 2d0) (-1073 2))

+		   ((-2d0 0d0) (-1073 2))

+		   ((0d0 2d0) (-1073 2))

+		   ((1d0 4d0) (1 3))

+		   ((-4d0 -1d0) (1 3))

+		   (((0d0) (10d0)) (-1073 4))

+		   (((0.5d0) (4d0)) (0 3))))

+    (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))

+	entry

+      (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))

+		     (c::decode-float-exp-derive-type-aux

+		      (c::specifier-type `(double-float ,arg-lo ,arg-hi)))

+		     arg-lo

+		     arg-hi))))

+

+(define-test issue.59.1-float

+  (:tag :issues)

+  (dolist (entry '(((-2f0 2f0) (-148 2))

+		   ((-2f0 0f0) (-148 2))

+		   ((0f0 2f0) (-148 2))

+		   ((1f0 4f0) (1 3))

+		   ((-4f0 -1f0) (1 3))

+		   (((0f0) (10f0)) (-148 4))

+		   (((0.5f0) (4f0)) (0 3))))

+    (destructuring-bind ((arg-lo arg-hi) (result-lo result-hi))

+	entry

+      (assert-equalp (c::specifier-type `(integer ,result-lo ,result-hi))

+		     (c::decode-float-exp-derive-type-aux

+		      (c::specifier-type `(single-float ,arg-lo ,arg-hi)))

+		     arg-lo

+		     arg-hi))))

Raymond Toy pushed to branch rtoy-fix-59-derive-decode-float at cmucl / cmucl

Commits:

3 changed files:

Changes: