nil
(set-bound y (consp x)))))))
+(defun safe-double-coercion-p (x)
+ (or (typep x 'double-float)
+ (<= most-negative-double-float x most-positive-double-float)))
+
+(defun safe-single-coercion-p (x)
+ (or (typep x 'single-float)
+ ;; Fix for bug 420, and related issues: during type derivation we often
+ ;; end up deriving types for both
+ ;;
+ ;; (some-op <int> <single>)
+ ;; and
+ ;; (some-op (coerce <int> 'single-float) <single>)
+ ;;
+ ;; or other equivalent transformed forms. The problem with this is that
+ ;; on some platforms like x86 (+ <int> <single>) is on the machine level
+ ;; equivalent of
+ ;;
+ ;; (coerce (+ (coerce <int> 'double-float)
+ ;; (coerce <single> 'double-float))
+ ;; 'single-float)
+ ;;
+ ;; so if the result of (coerce <int> 'single-float) is not exact, the
+ ;; derived types for the transformed forms will have an empty
+ ;; intersection -- which in turn means that the compiler will conclude
+ ;; that the call never returns, and all hell breaks lose when it *does*
+ ;; return at runtime. (This affects not just +, but other operators are
+ ;; well.)
+ (and (not (typep x `(or (integer * (,most-negative-exactly-single-float-fixnum))
+ (integer (,most-positive-exactly-single-float-fixnum) *))))
+ (<= most-negative-single-float x most-positive-single-float))))
+
;;; Apply a binary operator OP to two bounds X and Y. The result is
;;; NIL if either is NIL. Otherwise bound is computed and the result
;;; is open if either X or Y is open.
(defmacro safely-binop (op x y)
`(cond
- ((typep ,x 'single-float)
- (if (or (typep ,y 'single-float)
- (<= most-negative-single-float ,y most-positive-single-float))
- (,op ,x ,y)))
- ((typep ,x 'double-float)
- (if (or (typep ,y 'double-float)
- (<= most-negative-double-float ,y most-positive-double-float))
- (,op ,x ,y)))
- ((typep ,y 'single-float)
- (if (<= most-negative-single-float ,x most-positive-single-float)
- (,op ,x ,y)))
- ((typep ,y 'double-float)
- (if (<= most-negative-double-float ,x most-positive-double-float)
- (,op ,x ,y)))
- (t (,op ,x ,y))))
+ ((typep ,x 'double-float)
+ (when (safe-double-coercion-p ,y)
+ (,op ,x ,y)))
+ ((typep ,y 'double-float)
+ (when (safe-double-coercion-p ,x)
+ (,op ,x ,y)))
+ ((typep ,x 'single-float)
+ (when (safe-single-coercion-p ,y)
+ (,op ,x ,y)))
+ ((typep ,y 'single-float)
+ (when (safe-single-coercion-p ,x)
+ (,op ,x ,y)))
+ (t (,op ,x ,y))))
(defmacro bound-binop (op x y)
`(and ,x ,y
(def eq)
(def char=))
-;;; True if EQL comparisons involving type can be simplified to EQ.
-(defun eq-comparable-type-p (type)
- (csubtypep type (specifier-type '(or fixnum (not number)))))
-
;;; This is similar to SIMPLE-EQUALITY-TRANSFORM, except that we also
;;; try to convert to a type-specific predicate or EQ:
;;; -- If both args are characters, convert to CHAR=. This is better than
(eq (first (second good-cons-type)) 'member))
`(,(second (second good-cons-type))
,@(unconsify-type (caddr good-cons-type))))))
- (coerceable-p (c-type)
+ (coerceable-p (part)
;; Can the value be coerced to the given type? Coerce is
;; complicated, so we don't handle every possible case
;; here---just the most common and easiest cases:
;; the requested type, because (by assumption) COMPLEX
;; (and other difficult types like (COMPLEX INTEGER)
;; aren't specialized types.
- (let ((coerced-type c-type))
- (or (and (subtypep coerced-type 'float)
- (csubtypep value-type (specifier-type 'real)))
- (and (subtypep coerced-type
- '(or (complex single-float)
- (complex double-float)))
- (csubtypep value-type (specifier-type 'number))))))
+ (let ((coerced-type (careful-specifier-type part)))
+ (when coerced-type
+ (or (and (csubtypep coerced-type (specifier-type 'float))
+ (csubtypep value-type (specifier-type 'real)))
+ (and (csubtypep coerced-type
+ (specifier-type `(or (complex single-float)
+ (complex double-float))))
+ (csubtypep value-type (specifier-type 'number)))))))
(process-types (type)
;; FIXME: This needs some work because we should be able
;; to derive the resulting type better than just the