GitLab

at 2018-02-03T08:57:28-08:00

Fix #59: type derivation for decode-float exponent

Type derivation for exponent part of decode-float was incorrect.  We
need to take the absolute value of the argument before deriving the
type since the exponent is, of course, independent of the sign of the
number.  In the test case, the negative interval caused the lower and
upper bounds to be reversed, resulting in an invalid interval.

@@ -2028,31 +2028,36 @@
  (defun decode-float-exp-derive-type-aux (arg)
    ;; Derive the exponent part of the float.  It's always an integer
    ;; type.
 -  (flet ((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).
 -	   (nth-value 1 (decode-float (if (eq 'single-float (numeric-type-format arg))
 -					  least-positive-single-float
 -					  least-positive-double-float))))
 -	 (max-exp ()
 -	   ;; 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).
 -	   (if (eq (numeric-type-format arg) 'single-float)
 -	       (nth-value 1 (decode-float most-positive-single-float))
 -	       (nth-value 1 (decode-float most-positive-double-float)))))
 -    (let* ((lo (or (bound-func #'calc-exp
 -			       (numeric-type-low arg))
 -		   (min-exp)))
 -	   (hi (or (bound-func #'calc-exp
 -			       (numeric-type-high arg))
 -		   (max-exp))))
 +  (labels
 +      ((calc-exp (x)
 +	 (when x
 +	   (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).
 +	 (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)

@@ -28,7 +28,7 @@
    #+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)))))

@@ -443,3 +443,64 @@
  		    (write (read-from-string "`(,@vars ,@vars)")
  			   :pretty t
  			   :stream s)))))
++
 +(define-test issue.59
 +  (:tag :issues)
 +  (let ((f (compile nil #'(lambda (z)
 +			    (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))))
 \ No newline at end of file

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

3 changed files:

Changes: