Commit 90df7817 authored by Raymond Toy's avatar Raymond Toy
Browse files

Merge branch 'rtoy-fix-59-derive-decode-float' into 'master' 

Fix #59: derive decode float

Closes #59

See merge request cmucl/cmucl!34
parents e7f97a5d 7b336362

src/compiler/float-tran.lisp

+30 −25
Original line number Diff line number Diff line
@@ -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)

  (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).

	   (nth-value 1 (decode-float (if (eq 'single-float (numeric-type-format arg))

	   (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))))

	 (max-exp ()

			  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).

	   (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))))

	 (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)

tests/float-tran.lisp

+1 −1
Original line number Diff line number Diff line
@@ -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)))))

tests/issues.lisp

+61 −0
Original line number Diff line number Diff line
@@ -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