Change what (log -0.0) returns.

IEEE recommends -inf.
While CLHS has (complex (log (abs x)) (phase x)) as a definition (even
then, ambiguously it says "a complex logarithm"), we already don't
follow a similar definition for sqrt, (sqrt x) = (exp (/ (log x) 2)),
and return (sqrt -0.0) = -0.0

There also had been some confusion around type derivation and (log
(double-float 0d0)) derived as double-float. And an inlined log
produced -inf.

src/code/irrat.lisp

@@ -398,23 +398,23 @@
       (sqrt number)))
 
 (defun log-double-float (number)
-  (if (float-sign-bit-set-p number)
+  (if (< number 0)
       (complex (log (- number)) pi)
       (log number)))
 
 (defun log-single-float (number)
-  (if (float-sign-bit-set-p number)
+  (if (< number 0)
       (complex (log (- number)) (coerce pi 'single-float))
       (log number)))
 
 (defun log-double-float2 (number base)
-  (if (or (float-sign-bit-set-p number)
+  (if (or (< number 0)
           (< base 0))
       (/ (log number) (log base))
       (truly-the double-float (log number base))))
 
 (defun log-single-float2 (number base)
-  (if (or (float-sign-bit-set-p number)
+  (if (or (< number 0)
           (< base 0))
       (/ (log number) (log base))
       (truly-the single-float (log number base))))
@@ -554,10 +554,8 @@
                                 log2e)
                              'single-float)))))
           (((foreach single-float double-float))
-           ;; Is (log -0) -infinity (libm.a) or -infinity + i*pi (Kahan)?
-           ;; Since this doesn't seem to be an implementation issue
-           ;; I (pw) take the Kahan result.
-           (if (float-sign-bit-set-p number)
+           ;; IEEE 754 says (log -0.0) should be -inf
+           (if (< number 0.0)
                (complex (log (- number)) (coerce pi '(dispatch-type number)))
                (coerce (%log (coerce number 'double-float))
                        '(dispatch-type number))))

src/compiler/float-tran.lisp

@@ -501,7 +501,7 @@
   (deftransform log ((x) ($type) * :node node)
     (let ((cast (cast-or-check-bound-type node (specifier-type 'real))))
       (if cast
-          `(if (float-sign-bit-set-p x)
+          `(if (< x 0)
                (sb-vm::op-not-type1-error x '(,(type-specifier cast) . log))
                (truly-the $type (log (truly-the (float 0.0) x))))
           (give-up-ir1-transform))))
@@ -509,8 +509,7 @@
   (deftransform log ((x y) ($type $type) * :node node)
     (let ((cast (cast-or-check-bound-type node (specifier-type 'real))))
       (if cast
-          `(if (or (float-sign-bit-set-p x)
-                   ;; The out of line definition returns 0 for all zeros
+          `(if (or (< x 0)
                    (< y 0))
                (sb-vm::op-not-type2-error x y '(,(type-specifier cast) . log))
                (truly-the $type (log (truly-the (float 0.0) x)
@@ -1107,15 +1106,13 @@
 (defoptimizer (expt derive-type) ((x y))
   (two-arg-derive-type x y #'expt-derive-type-aux))
 
-;;; Note we must assume that a type including 0.0 may also include
-;;; -0.0 and thus the result may be complex -infinity + i*pi.
 (defun log-derive-type-aux-1 (x)
   (elfun-derive-type-simple x #'log
-                            (if (integer-type-p x) 0 0d0)
+                            (if (integer-type-p x) 0 -0d0)
                             nil
                             ;; (log 0) is an error
-                            ;; and there's nothing between 0 and 1 forr integers.
-                            (and (integer-type-p x) 0f0)
+                            ;; and there's nothing between 0 and 1 for integers.
+                            (and (integer-type-p x) -0f0)
                             nil))
 
 (defun log-derive-type-aux-2 (x y same-arg)

tests/float-2.pure.lisp

@@ -458,17 +458,16 @@ fractional bits."
                  (declare (double-float y))
                  (log y 2.0d0))
                (or double-float (complex double-float)))
-  ;; (assert-type (lambda (d)
-  ;;                (declare ((double-float 0d0) d))
-  ;;                (when (< d 1.0d0)
-  ;;                  (log d)))
-  ;;              (or null (double-float * 0.0d0)))
-  ;; (assert-type (lambda (d)
-  ;;                (declare ((double-float 0d0) d))
-  ;;                (when (< d 1.0d0)
-  ;;                  (log d 2.0d0)))
-  ;;              (or null (double-float * 0.0d0)))
-  )
+  (assert-type (lambda (d)
+                 (declare ((double-float 0d0) d))
+                 (when (< d 1.0d0)
+                   (log d)))
+               (or null (double-float * 0.0d0)))
+  (assert-type (lambda (d)
+                 (declare ((double-float 0d0) d))
+                 (when (< d 1.0d0)
+                   (log d 2.0d0)))
+               (or null (double-float * 0.0d0))))
 
 (with-test (:name (ftruncate :minus-zeros :one-arg))
   (flet ((f (x) (declare (notinline ftruncate)) (ftruncate x)))

validate-float.lisp

@@ -26,9 +26,7 @@
                              (symbol (eql x y))
                              (rational (eql x y))
                              (float (= x y))
-                             (string (string= x y))
-                             ;; KLUDGE
-                             (complex t))))
+                             (string (string= x y)))))
                   (unless (eqal actual result)
                     (cerror "Continue"
                             "FLOAT CACHE LINE ~S vs COMPUTED ~S~%"