0.8alpha.0.32:

[sbcl.git] / src / compiler / typetran.lisp

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 06f0de1..e198379 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -155,7 +155,6 @@
 ;;; 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))
@@ -171,49 +170,6 @@
                    `((< (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)))))))))))
-
 ;;; Do source transformation of a test of a known numeric type. We can
 ;;; assume that the type doesn't have a corresponding predicate, since
 ;;; those types have already been picked off. In particular, CLASS
@@ -554,7 +510,12 @@
             ((csubtypep tspec (specifier-type 'float))
              '(%single-float x))
             ((and (csubtypep tspec (specifier-type 'simple-vector))
-                  (policy node (< safety 3)))
+                  ;; Can we avoid checking for dimension issues like
+                  ;; (COERCE FOO '(SIMPLE-VECTOR 5)) returning a
+                  ;; vector of length 6?
+                  (or (policy node (< safety 3)) ; no need in unsafe code
+                      (and (array-type-p tspec) ; no need when no dimensions
+                           (equal (array-type-dimensions tspec) '(*)))))
              `(if (simple-vector-p x)
                   x
                   (replace (make-array (length x)) x)))
@@ -562,3 +523,4 @@
             (t
              (give-up-ir1-transform)))))))
 
+