0.6.11.17:

[sbcl.git] / src / compiler / float-tran.lisp

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index 69faaae..618ac95 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -12,9 +12,6 @@
 ;;;; files for more information.
 
 (in-package "SB!C")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; coercions
 
@@ -183,11 +180,9 @@
 
 ;;; toy@rtp.ericsson.se:
 ;;;
-;;; Optimizers for scale-float. If the float has bounds, new bounds
+;;; optimizers for SCALE-FLOAT. If the float has bounds, new bounds
 ;;; are computed for the result, if possible.
 
-#-sb-xc-host ;(CROSS-FLOAT-INFINITY-KLUDGE, see base-target-features.lisp-expr)
-(progn
 #!+propagate-float-type
 (progn
 
@@ -252,7 +247,7 @@
             (one-arg-derive-type num #',aux-name #',fun))))))
   (frob %single-float single-float)
   (frob %double-float double-float))
-)) ; PROGN PROGN
+) ; PROGN 
 \f
 ;;;; float contagion
 
@@ -565,8 +560,6 @@
                                (minusp (float-sign arg-hi-val))
                                (plusp (float-sign arg-hi-val))))))))))
 
-;;; Elfun-Derive-Type-Simple
-;;;
 ;;; Handle monotonic functions of a single variable whose domain is
 ;;; possibly part of the real line. ARG is the variable, FCN is the
 ;;; function, and DOMAIN is a specifier that gives the (real) domain
@@ -747,7 +740,6 @@
             (interval-expt-< pos y))))))
 
 ;;; Compute bounds for (expt x y).
-
 (defun interval-expt (x y)
   (case (interval-range-info x 1)
     ('+
@@ -872,8 +864,8 @@
 (defun merged-interval-expt (x y)
   (let* ((x-int (numeric-type->interval x))
         (y-int (numeric-type->interval y)))
-    (mapcar #'(lambda (type)
-               (fixup-interval-expt type x-int y-int x y))
+    (mapcar (lambda (type)
+             (fixup-interval-expt type x-int y-int x y))
            (flatten-list (interval-expt x-int y-int)))))
 
 (defun expt-derive-type-aux (x y same-arg)
@@ -908,16 +900,13 @@
 (defun log-derive-type-aux-2 (x y same-arg)
   (let ((log-x (log-derive-type-aux-1 x))
        (log-y (log-derive-type-aux-1 y))
-       (result '()))
-    ;; log-x or log-y might be union types. We need to run through
-    ;; the union types ourselves because /-derive-type-aux doesn't.
+       (accumulated-list nil))
+    ;; LOG-X or LOG-Y might be union types. We need to run through
+    ;; the union types ourselves because /-DERIVE-TYPE-AUX doesn't.
     (dolist (x-type (prepare-arg-for-derive-type log-x))
       (dolist (y-type (prepare-arg-for-derive-type log-y))
-       (push (/-derive-type-aux x-type y-type same-arg) result)))
-    (setf result (flatten-list result))
-    (if (rest result)
-       (make-union-type result)
-       (first result))))
+       (push (/-derive-type-aux x-type y-type same-arg) accumulated-list)))
+    (apply #'type-union (flatten-list accumulated-list))))
 
 (defoptimizer (log derive-type) ((x &optional y))
   (if y
@@ -1018,7 +1007,6 @@
 
 ;;; Make REALPART and IMAGPART return the appropriate types. This
 ;;; should help a lot in optimized code.
-
 (defun realpart-derive-type-aux (type)
   (let ((class (numeric-type-class type))
        (format (numeric-type-format type)))
@@ -1039,11 +1027,9 @@
                              :complexp :real
                              :low (numeric-type-low type)
                              :high (numeric-type-high type))))))
-
 #!+(or propagate-fun-type propagate-float-type)
 (defoptimizer (realpart derive-type) ((num))
   (one-arg-derive-type num #'realpart-derive-type-aux #'realpart))
-
 (defun imagpart-derive-type-aux (type)
   (let ((class (numeric-type-class type))
        (format (numeric-type-format type)))
@@ -1065,7 +1051,6 @@
                              :complexp :real
                              :low (numeric-type-low type)
                              :high (numeric-type-high type))))))
-
 #!+(or propagate-fun-type propagate-float-type)
 (defoptimizer (imagpart derive-type) ((num))
   (one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart))
@@ -1098,10 +1083,9 @@
             (rat-result-p (csubtypep element-type
                                      (specifier-type 'rational))))
        (if rat-result-p
-           (make-union-type
-            (list element-type
-                  (specifier-type
-                   `(complex ,(numeric-type-class element-type)))))
+           (type-union element-type
+                       (specifier-type
+                        `(complex ,(numeric-type-class element-type))))
            (make-numeric-type :class (numeric-type-class element-type)
                               :format (numeric-type-format element-type)
                               :complexp (if rat-result-p