;;; binds specified by TYPE. BASE is the name of the base type, for
;;; declaration. We make SAFETY locally 0 to inhibit any checking of
;;; this assertion.
-#!-negative-zero-is-not-zero
(defun transform-numeric-bound-test (n-object type base)
(declare (type numeric-type type))
(let ((low (numeric-type-low type))
(declare (optimize (safety 0)))
(and ,@(when low
(if (consp low)
- `((> (the ,base ,n-object) ,(car low)))
- `((>= (the ,base ,n-object) ,low))))
+ `((> (truly-the ,base ,n-object) ,(car low)))
+ `((>= (truly-the ,base ,n-object) ,low))))
,@(when high
(if (consp high)
- `((< (the ,base ,n-object) ,(car high)))
- `((<= (the ,base ,n-object) ,high))))))))
-
-#!+negative-zero-is-not-zero
-(defun transform-numeric-bound-test (n-object type base)
- (declare (type numeric-type type))
- (let ((low (numeric-type-low type))
- (high (numeric-type-high type))
- (float-type-p (csubtypep type (specifier-type 'float)))
- (x (gensym))
- (y (gensym)))
- `(locally
- (declare (optimize (safety 0)))
- (and ,@(when low
- (if (consp low)
- `((let ((,x (the ,base ,n-object))
- (,y ,(car low)))
- ,(if (not float-type-p)
- `(> ,x ,y)
- `(if (and (zerop ,x) (zerop ,y))
- (> (float-sign ,x) (float-sign ,y))
- (> ,x ,y)))))
- `((let ((,x (the ,base ,n-object))
- (,y ,low))
- ,(if (not float-type-p)
- `(>= ,x ,y)
- `(if (and (zerop ,x) (zerop ,y))
- (>= (float-sign ,x) (float-sign ,y))
- (>= ,x ,y)))))))
- ,@(when high
- (if (consp high)
- `((let ((,x (the ,base ,n-object))
- (,y ,(car high)))
- ,(if (not float-type-p)
- `(< ,x ,y)
- `(if (and (zerop ,x) (zerop ,y))
- (< (float-sign ,x) (float-sign ,y))
- (< ,x ,y)))))
- `((let ((,x (the ,base ,n-object))
- (,y ,high))
- ,(if (not float-type-p)
- `(<= ,x ,y)
- `(if (and (zerop ,x) (zerop ,y))
- (<= (float-sign ,x) (float-sign ,y))
- (<= ,x ,y)))))))))))
+ `((< (truly-the ,base ,n-object) ,(car high)))
+ `((<= (truly-the ,base ,n-object) ,high))))))))
;;; Do source transformation of a test of a known numeric type. We can
;;; assume that the type doesn't have a corresponding predicate, since
,(transform-numeric-bound-test n-object type base)))
(:complex
`(and (complexp ,n-object)
- ,(once-only ((n-real `(realpart (the complex ,n-object)))
- (n-imag `(imagpart (the complex ,n-object))))
+ ,(once-only ((n-real `(realpart (truly-the complex ,n-object)))
+ (n-imag `(imagpart (truly-the complex ,n-object))))
`(progn
,n-imag ; ignorable
(and (typep ,n-real ',base)