0.8alpha.0.37:

[sbcl.git] / src / code / late-type.lisp

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 6f6e610..ec42475 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -97,8 +97,7 @@
 ;;;
 ;;; WHEN controls when the forms are executed.
 (defmacro !define-superclasses (type-class-name specs when)
 ;;;
 ;;; WHEN controls when the forms are executed.
 (defmacro !define-superclasses (type-class-name specs when)

-  (let ((type-class (gensym "TYPE-CLASS-"))
-       (info (gensym "INFO")))
+  (with-unique-names (type-class info)

     `(,when
        (let ((,type-class (type-class-or-lose ',type-class-name))
             (,info (mapcar (lambda (spec)
     `(,when
        (let ((,type-class (type-class-or-lose ',type-class-name))
             (,info (mapcar (lambda (spec)

@@ -1322,8 +1321,10 @@
        (let ((members (member-type-members not-type)))
         (if (some #'floatp members)
             (let (floats)
        (let ((members (member-type-members not-type)))
         (if (some #'floatp members)
             (let (floats)

-              (dolist (pair '((0.0f0 . -0.0f0) (0.0d0 . -0.0d0)
-                              #!+long-float (0.0l0 . -0.0l0)))
+              (dolist (pair `((0.0f0 . ,(load-time-value (make-unportable-float :single-float-negative-zero)))
+                              (0.0d0 . ,(load-time-value (make-unportable-float :double-float-negative-zero)))
+                              #!+long-float
+                              (0.0l0 . ,(load-time-value (make-unportable-float :long-float-negative-zero)))))

                 (when (member (car pair) members)
                   (aver (not (member (cdr pair) members)))
                   (push (cdr pair) floats)
                 (when (member (car pair) members)
                   (aver (not (member (cdr pair) members)))
                   (push (cdr pair) floats)

@@ -1548,17 +1549,17 @@
          ((consp low-bound)
           (let ((low-value (car low-bound)))
             (or (eql low-value high-bound)
          ((consp low-bound)
           (let ((low-value (car low-bound)))
             (or (eql low-value high-bound)

-                (and (eql low-value -0f0) (eql high-bound 0f0))
-                (and (eql low-value 0f0) (eql high-bound -0f0))
-                (and (eql low-value -0d0) (eql high-bound 0d0))
-                (and (eql low-value 0d0) (eql high-bound -0d0)))))
+                (and (eql low-value (load-time-value (make-unportable-float :single-float-negative-zero))) (eql high-bound 0f0))
+                (and (eql low-value 0f0) (eql high-bound (load-time-value (make-unportable-float :single-float-negative-zero))))
+                (and (eql low-value (load-time-value (make-unportable-float :double-float-negative-zero))) (eql high-bound 0d0))
+                (and (eql low-value 0d0) (eql high-bound (load-time-value (make-unportable-float :double-float-negative-zero)))))))

          ((consp high-bound)
           (let ((high-value (car high-bound)))
             (or (eql high-value low-bound)
          ((consp high-bound)
           (let ((high-value (car high-bound)))
             (or (eql high-value low-bound)

-                (and (eql high-value -0f0) (eql low-bound 0f0))
-                (and (eql high-value 0f0) (eql low-bound -0f0))
-                (and (eql high-value -0d0) (eql low-bound 0d0))
-                (and (eql high-value 0d0) (eql low-bound -0d0)))))
+                (and (eql high-value (load-time-value (make-unportable-float :single-float-negative-zero))) (eql low-bound 0f0))
+                (and (eql high-value 0f0) (eql low-bound (load-time-value (make-unportable-float :single-float-negative-zero))))
+                (and (eql high-value (load-time-value (make-unportable-float :double-float-negative-zero))) (eql low-bound 0d0))
+                (and (eql high-value 0d0) (eql low-bound (load-time-value (make-unportable-float :double-float-negative-zero)))))))

          ((and (eq (numeric-type-class low) 'integer)
                (eq (numeric-type-class high) 'integer))
           (eql (1+ low-bound) high-bound))
          ((and (eq (numeric-type-class low) 'integer)
                (eq (numeric-type-class high) 'integer))
           (eql (1+ low-bound) high-bound))