From 4ece2b2cf6eaf8cbade95c2aaa072e32f12e0069 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 23 Jan 2007 19:09:51 +0000
Subject: [PATCH] Fix expt derive-type optimizer.  The compiler was deriving
 the result type of:

    (defun foo3 (x y)
      (declare (type (double-float (0d0) 1d0) x)
	       (type (double-float (0d0)) y))
      (expt x y))

to be (double-float 0d0 1d0), i.e, including -0.0, but that's not
possible.  With this fix, the result type is (or (member 0d0)
(double-float (0d0) 1d0)), which is better.
---
 compiler/float-tran.lisp | 63 ++++++++++++++++++++++++----------------
 1 file changed, 38 insertions(+), 25 deletions(-)

diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index f724e047b..d40a57b60 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.108 2006/08/21 16:39:54 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.109 2007/01/23 19:09:51 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -968,7 +968,15 @@
 			     (c::bound-value (c::interval-high y))))
 	      (hi (safe-expt (c::bound-value (c::interval-high x))
 			     (c::bound-value (c::interval-low y)))))
-	  (list (c::make-interval :low (or lo 0) :high (or hi 1)))))
+	  ;; If the low bound, LO, is NIL, that means the we have
+	  ;; +0.0^inf, which is +0.0, but NIL is returned by
+	  ;; SAFE-EXPT.  That means the result is includes +0.0.  Make
+	  ;; it so by returning a member type and an exclusive
+	  ;; interval.
+	  (if lo
+	      (list (c::make-interval :low lo :high (or hi 1)))
+	      (list (c::make-interval :low (list 0) :high (or hi 1))
+		    (c::make-member-type :members (list 0))))))
        ('-
 	;; Y is negative and log x <= 0.  The range of exp(y * log(x)) is
 	;; obviously [1, inf].
@@ -1053,8 +1061,7 @@
 	      res))
 	   (t
 	    ;; Positive integer to a number is a number (for now)
-	    (specifier-type 'number)))
-	 )
+	    (specifier-type 'number))))
 	((csubtypep x-type (specifier-type 'rational))
 	 ;; A rational to some power
 	 (case (numeric-type-class y-type)
@@ -1089,29 +1096,35 @@
 	      res))
 	   (t
 	    ;; Positive rational to a number is a number (for now)
-	    (specifier-type 'number)))
-	 )
+	    (specifier-type 'number))))
 	((csubtypep x-type (specifier-type 'float))
 	 ;; A float to some power
-	 (case (numeric-type-class y-type)
-	   ((or integer rational)
-	    ;; Positive float to an integer or rational power is always a float
-	    (make-numeric-type
-	     :class 'float
-	     :format (numeric-type-format x-type)
-	     :low (interval-low bnd)
-	     :high (interval-high bnd)))
-	   (float
-	    ;; Positive float to a float power is a float of the higher type
-	    (make-numeric-type
-	     :class 'float
-	     :format (float-format-max (numeric-type-format x-type)
-				       (numeric-type-format y-type))
-	     :low (interval-low bnd)
-	     :high (interval-high bnd)))
-	   (t
-	    ;; Positive float to a number is a number (for now)
-	    (specifier-type 'number))))
+	 (flet ((make-result (type)
+		  (let ((res-type (or type 'float)))
+		    (etypecase bnd
+		      (member-type
+		       ;; Coerce all elements to the appropriate float
+		       ;; type.
+		       (make-member-type :members (mapcar #'(lambda (x)
+							      (coerce x res-type))
+							  (member-type-members bnd))))
+		      (interval
+		       (make-numeric-type
+			:class 'float
+			:format type
+			:low (coerce-numeric-bound (interval-low bnd) res-type)
+			:high (coerce-numeric-bound (interval-high bnd) res-type)))))))
+	   (case (numeric-type-class y-type)
+	     ((or integer rational)
+	      ;; Positive float to an integer or rational power is always a float
+	      (make-result (numeric-type-format x-type)))
+	     (float
+	      ;; Positive float to a float power is a float of the higher type
+	      (make-result (float-format-max (numeric-type-format x-type)
+					     (numeric-type-format y-type))))
+	     (t
+	      ;; Positive float to a number is a number (for now)
+	      (specifier-type 'number)))))
 	(t
 	 ;; A number to some power is a number.
 	 (specifier-type 'number))))
-- 
GitLab