`(coerce (,',prim-quick (coerce x 'double-float))
'single-float))
(t
- (compiler-note
+ (compiler-notify
"unable to avoid inline argument range check~@
because the argument range (~S) was not within 2^64"
(type-specifier (continuation-type x)))
(#.(expt 2d0 64)))))
`(,',prim-quick x))
(t
- (compiler-note
+ (compiler-notify
"unable to avoid inline argument range check~@
because the argument range (~S) was not within 2^64"
(type-specifier (continuation-type x)))
;; Check that the ARG bounds are correctly canonicalized.
(when (and arg-lo (floatp arg-lo-val) (zerop arg-lo-val) (consp arg-lo)
(minusp (float-sign arg-lo-val)))
- (compiler-note "float zero bound ~S not correctly canonicalized?" arg-lo)
- (setq arg-lo '(0e0) arg-lo-val 0e0))
+ (compiler-notify "float zero bound ~S not correctly canonicalized?" arg-lo)
+ (setq arg-lo 0e0 arg-lo-val arg-lo))
(when (and arg-hi (zerop arg-hi-val) (floatp arg-hi-val) (consp arg-hi)
(plusp (float-sign arg-hi-val)))
- (compiler-note "float zero bound ~S not correctly canonicalized?" arg-hi)
- (setq arg-hi `(,(ecase *read-default-float-format*
- (double-float (load-time-value (make-unportable-float :double-float-negative-zero)))
- #!+long-float
- (long-float (load-time-value (make-unportable-float :long-float-negative-zero)))))
- arg-hi-val (ecase *read-default-float-format*
- (double-float (load-time-value (make-unportable-float :double-float-negative-zero)))
- #!+long-float
- (long-float (load-time-value (make-unportable-float :long-float-negative-zero))))))
- (and (or (null domain-low)
- (and arg-lo (>= arg-lo-val domain-low)
- (not (and (zerop domain-low) (floatp domain-low)
- (plusp (float-sign domain-low))
- (zerop arg-lo-val) (floatp arg-lo-val)
- (if (consp arg-lo)
- (plusp (float-sign arg-lo-val))
- (minusp (float-sign arg-lo-val)))))))
- (or (null domain-high)
- (and arg-hi (<= arg-hi-val domain-high)
- (not (and (zerop domain-high) (floatp domain-high)
- (minusp (float-sign domain-high))
- (zerop arg-hi-val) (floatp arg-hi-val)
- (if (consp arg-hi)
- (minusp (float-sign arg-hi-val))
- (plusp (float-sign arg-hi-val))))))))))
+ (compiler-notify "float zero bound ~S not correctly canonicalized?" arg-hi)
+ (setq arg-hi (ecase *read-default-float-format*
+ (double-float (load-time-value (make-unportable-float :double-float-negative-zero)))
+ #!+long-float
+ (long-float (load-time-value (make-unportable-float :long-float-negative-zero))))
+ arg-hi-val arg-hi))
+ (flet ((fp-neg-zero-p (f) ; Is F -0.0?
+ (and (floatp f) (zerop f) (minusp (float-sign f))))
+ (fp-pos-zero-p (f) ; Is F +0.0?
+ (and (floatp f) (zerop f) (plusp (float-sign f)))))
+ (and (or (null domain-low)
+ (and arg-lo (>= arg-lo-val domain-low)
+ (not (and (fp-pos-zero-p domain-low)
+ (fp-neg-zero-p arg-lo)))))
+ (or (null domain-high)
+ (and arg-hi (<= arg-hi-val domain-high)
+ (not (and (fp-neg-zero-p domain-high)
+ (fp-pos-zero-p arg-hi)))))))))
(eval-when (:compile-toplevel :execute)
(setf *read-default-float-format* 'single-float))
;;; have too much roundoff. Thus we have to do it the hard way.
(defun safe-expt (x y)
(handler-case
- (expt x y)
+ (when (< (abs y) 10000)
+ (expt x y))
(error ()
nil)))
;;; Handle the case when x >= 1.
(defun interval-expt-> (x y)
(case (sb!c::interval-range-info y 0d0)
- ('+
+ (+
;; Y is positive and log X >= 0. The range of exp(y * log(x)) is
;; obviously non-negative. We just have to be careful for
;; infinite bounds (given by nil).
(hi (safe-expt (type-bound-number (sb!c::interval-high x))
(type-bound-number (sb!c::interval-high y)))))
(list (sb!c::make-interval :low (or lo 1) :high hi))))
- ('-
+ (-
;; Y is negative and log x >= 0. The range of exp(y * log(x)) is
;; obviously [0, 1]. However, underflow (nil) means 0 is the
;; result.
;;; Handle the case when x <= 1
(defun interval-expt-< (x y)
(case (sb!c::interval-range-info x 0d0)
- ('+
+ (+
;; The case of 0 <= x <= 1 is easy
(case (sb!c::interval-range-info y)
- ('+
+ (+
;; Y is positive and log X <= 0. The range of exp(y * log(x)) is
;; obviously [0, 1]. We just have to be careful for infinite bounds
;; (given by nil).
(hi (safe-expt (type-bound-number (sb!c::interval-high x))
(type-bound-number (sb!c::interval-low y)))))
(list (sb!c::make-interval :low (or lo 0) :high (or hi 1)))))
- ('-
+ (-
;; Y is negative and log x <= 0. The range of exp(y * log(x)) is
;; obviously [1, inf].
(let ((hi (safe-expt (type-bound-number (sb!c::interval-low x))
(sb!c::interval-split 0 y t)
(list (interval-expt-< x y-)
(interval-expt-< x y+))))))
- ('-
+ (-
;; The case where x <= 0. Y MUST be an INTEGER for this to work!
;; The calling function must insure this! For now we'll just
;; return the appropriate unbounded float type.
;;; Compute bounds for (expt x y).
(defun interval-expt (x y)
(case (interval-range-info x 1)
- ('+
+ (+
;; X >= 1
(interval-expt-> x y))
- ('-
+ (-
;; X <= 1
(interval-expt-< x y))
(t
(bound-type (or format 'float)))
(cond ((numeric-type-real-p arg)
(case (interval-range-info (numeric-type->interval arg) 0.0)
- ('+
+ (+
;; The number is positive, so the phase is 0.
(make-numeric-type :class 'float
:format format
:complexp :real
:low (coerce 0 bound-type)
:high (coerce 0 bound-type)))
- ('-
+ (-
;; The number is always negative, so the phase is pi.
(make-numeric-type :class 'float
:format format
projects / sbcl.git / blobdiff