From 6d9d64ba9751e60d030f95fb7a50bab24560d7bd Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Thu, 19 Feb 1998 04:28:30 +0000
Subject: [PATCH] Rework many of the derive-type optimizers: 1. Correct
 handling of integer and rational arguments which give single-float results.
 2. Correct coercion of the number-type bounds. 3. Improve consistency.

Functions modified: float-or-complex-type, elfun-derive-type-simple,
atan-derive-type-aux-2, phase-derive-type, imagpart-derive-type-aux,
trig-derive-type-aux, abs-derive-type-aux. Remove function
elfun-float-format. Add function coerce-numeric-bound.

Add an optional increasingp argument to elfun-derive-type-simple
allowing it to be used for acos, and remove acos-derive-type-aux.
---
 compiler/float-tran.lisp | 388 ++++++++++++++++++---------------------
 compiler/srctran.lisp    |  24 +--
 2 files changed, 187 insertions(+), 225 deletions(-)

diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index b8a933782..7a146ced6 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.61 1998/02/05 16:55:16 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.62 1998/02/19 04:28:28 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -151,9 +151,9 @@
 	 (let ((n-f1 (gensym)))
 	   `(let ((,n-f1 ,float1))
 	      (declare (float ,n-f1))
-	      (if (minusp (if (typep ,n-f1 'single-float)
-			      (single-float-bits ,n-f1)
-			      (double-float-high-bits ,n-f1)))
+	      (if (etypecase ,n-f1
+		    (single-float (minusp (single-float-bits ,n-f1)))
+		    (double-float (minusp (double-float-high-bits ,n-f1))))
 		  (float -1 ,n-f1)
 		  (float 1 ,n-f1)))))))
 
@@ -319,7 +319,7 @@
 
 ;;; FLOAT-CONTAGION-ARG1, ARG2  --  Internal
 ;;;
-;;;    Do some stuff to recognize when the luser is doing mixed float and
+;;;    Do some stuff to recognize when the loser is doing mixed float and
 ;;; rational arithmetic, or different float types, and fix it up.  If we don't,
 ;;; he won't even get so much as an efficency note.
 ;;;
@@ -547,7 +547,7 @@
 (progn
 
 ;;; The number is of type REAL.
-(proclaim '(inline numeric-type-real-p))
+(declaim (inline numeric-type-real-p))
 (defun numeric-type-real-p (type)
   (and (numeric-type-p type)
        (eq (numeric-type-complexp type) :real)))
@@ -572,18 +572,26 @@
 ;;; DEFAULT-TYPE is the specifier-type of the result if COND should
 ;;; return NIL.
 
+;;; Coerce a numeric type bound to the given type while handling
+;;; exclusive bounds.
+(defun coerce-numeric-bound (bound type)
+  (if (consp bound)
+      (consp (coerce (car bound) type))
+      (coerce bound type)))
 
 ;;; Compute a specifier like '(or float (complex float)), except float
 ;;; should be the right kind of float.  Allow bounds for the float
 ;;; part too.
-(defun float-or-complex-type (num &optional lo hi)
-  (declare (type numeric-type num))
-  (let* ((f-type (or (numeric-type-format num) 'float))
-	 (lo (and lo (coerce lo f-type)))
-	 (hi (and hi (coerce hi f-type))))
-    (specifier-type `(or (,f-type ,(or lo '*)
-			          ,(or hi '*))
-			 (complex ,f-type)))))
+(defun float-or-complex-type (arg &optional lo hi)
+  (declare (type numeric-type arg))
+  (let* ((format (case (numeric-type-class arg)
+		   ((integer rational) 'single-float)
+		   (t (numeric-type-format arg))))
+	 (float-type (or format 'float))
+	 (lo (and lo (coerce-numeric-bound lo float-type)))
+	 (hi (and hi (coerce-numeric-bound hi float-type))))
+    (specifier-type `(or (,float-type ,(or lo '*) ,(or hi '*))
+		         (complex ,float-type)))))
 
 )  ; end progn
 
@@ -595,16 +603,18 @@
 ;;;; function, based on the domain of the input.
 ;;;;
 
-;;; ELFUN-DERIVE-TYPE-SIMPLE
+;;; Elfun-Derive-Type-Simple
 ;;; 
-;;; Handle monotonic increasing functions of a single variable whose
-;;; domain is possibly part of the real line.  ARG is the variable,
-;;; FCN is the function, and CSPEC is a specifier that gives the
-;;; (real) domain of the function.  If ARG is not a subtype of CSPEC,
-;;; then the function is assumed to return either a float or a complex
-;;; number.  DEFAULT-LO and DEFAULT-HI are the lower and upper bounds
-;;; if we can't compute the bounds using FCN.
-(defun elfun-derive-type-simple (arg fcn cspec default-lo default-hi)
+;;; 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 CSPEC is a specifier that gives the (real) domain of
+;;; the function.  If ARG is not a subtype of CSPEC, then the function
+;;; is assumed to return either a float or a complex number.
+;;; DEFAULT-LO and DEFAULT-HI are the lower and upper bounds if we
+;;; can't compute the bounds using FCN.
+;;;
+(defun elfun-derive-type-simple (arg fcn cspec default-lo default-hi
+				     &optional (increasingp t))
   (etypecase arg
     (numeric-type
      (cond ((eq (numeric-type-complexp arg) :complex)
@@ -612,48 +622,31 @@
 			       :format (numeric-type-format arg)
 			       :complexp :complex))
 	   ((numeric-type-real-p arg)
-	    (let ((lo (numeric-type-low arg))
-		  (hi (numeric-type-high arg)))
-	      (if (csubtypep arg cspec)
-		  (let ((res-lo (bound-func fcn lo))
-			(res-hi (bound-func fcn hi)))
-		    (if (csubtypep arg (specifier-type 'rational))
-			;; For a rational argument the default result
-			;; type is a single-float.
-			(let ((f-type (or (numeric-type-format arg)
-					  'single-float)))
-			  (make-numeric-type
-			   :class 'float
-			   :format f-type
-			   :low (or res-lo
-				    (and default-lo
-					 (coerce default-lo f-type)))
-			   :high (or res-hi
-				     (and default-hi
-					  (coerce default-hi f-type)))))
-			;; However for a real argument the default
-			;; result type is a float.
-			(make-numeric-type
-			 :class 'float
-			 :format (numeric-type-format arg)
-			 :low (or res-lo
-				  (when default-lo
-				    (if (numeric-type-format arg)
-					(coerce default-lo
-						(numeric-type-format arg))
-					default-lo)))
-			 :high (or res-hi
-				   (when default-hi
-				     (if (numeric-type-format arg)
-					 (coerce default-hi
-						 (numeric-type-format arg))
-					 default-hi))))))
-		  (float-or-complex-type arg))))
+	    (if (csubtypep arg cspec)
+		(let* ((low (numeric-type-low arg))
+		       (high (numeric-type-high arg))
+		       (res-lo (or (bound-func fcn (if increasingp low high))
+				   default-lo))
+		       (res-hi (or (bound-func fcn (if increasingp high low))
+				   default-hi))
+		       ;; Result specifier type.
+		       (format (case (numeric-type-class arg)
+				 ((integer rational) 'single-float)
+				 (t (numeric-type-format arg))))
+		       (bound-type (or format 'float)))
+		  (make-numeric-type
+		   :class 'float
+		   :format format
+		   :low (and res-lo
+			     (coerce-numeric-bound res-lo bound-type))
+		   :high (and res-hi
+			      (coerce-numeric-bound res-hi bound-type))))
+		(float-or-complex-type arg)))
 	   (t
 	    (float-or-complex-type arg default-lo default-hi))))))
 
 (macrolet
-    ((frob (name cspec def-lo-bnd def-hi-bnd)
+    ((frob (name cspec def-lo-bnd def-hi-bnd &key (increasingp t))
        (let ((num (gensym)))
 	 `(defoptimizer (,name derive-type) ((,num))
 	   (one-arg-derive-type
@@ -661,65 +654,30 @@
 	    #'(lambda (arg)
 		(elfun-derive-type-simple arg #',name
 					  ,cspec
-					  ,def-lo-bnd ,def-hi-bnd))
+					  ,def-lo-bnd ,def-hi-bnd
+					  ,increasingp))
 	    #',name)))))
   ;; These functions are easy because they are defined for the whole
   ;; real line.
-  (frob exp (specifier-type 'real)
-	0 nil)
-  (frob sinh (specifier-type 'real)
-	nil nil)
-  (frob tanh (specifier-type 'real)
-	-1 1)
-  (frob asinh (specifier-type 'real)
-	nil nil)
+  (frob exp (specifier-type 'real) 0 nil)
+  (frob sinh (specifier-type 'real) nil nil)
+  (frob tanh (specifier-type 'real) -1 1)
+  (frob asinh (specifier-type 'real) nil nil)
 
   ;; These functions are only defined for part of the real line.  The
   ;; condition selects the desired part of the line.  
-  (frob asin (specifier-type '(real -1d0 1d0))
-	#.(- (/ pi 2)) #.(/ pi 2))
-  (frob acosh (specifier-type '(real 1d0))
-	nil nil)
-  (frob atanh (specifier-type '(real -1d0 1d0))
-	-1 1)
+  (frob asin (specifier-type '(real -1l0 1l0)) (- (/ pi 2)) (/ pi 2))
+  ;; Acos is monotonic decreasing, so we need to swap the function
+  ;; values at the lower and upper bounds of the input domain.
+  (frob acos (specifier-type '(real -1l0 1l0)) 0 pi :increasingp nil)
+  (frob acosh (specifier-type '(real 1l0)) nil nil)
+  (frob atanh (specifier-type '(real -1l0 1l0))	-1 1)
   (frob sqrt (specifier-type
-	      #-negative-zero-is-not-zero '(or (member 0f0 0d0) (real (0d0)))
-	      #+negative-zero-is-not-zero '(real 0d0))
+	      #-negative-zero-is-not-zero '(or (member 0f0 0d0)
+					       (real (0l0)))
+	      #+negative-zero-is-not-zero '(real 0l0))
 	0 nil))
  
-
-;;; Acos is monotonic decreasing, so we need to swap the function
-;;; values at the lower and upper bounds of the input domain.
-;;;
-(defun acos-derive-type-aux (arg)
-  (etypecase arg
-    (numeric-type
-     (cond ((eq (numeric-type-complexp arg) :complex)
-	    (make-numeric-type :class (numeric-type-class arg)
-			       :format (numeric-type-format arg)
-			       :complexp :complex))
-	   ((numeric-type-real-p arg)
-	    (let ((float-type (or (numeric-type-format arg) 'float))
-		  (lo (numeric-type-low arg))
-		  (hi (numeric-type-high arg)))
-	      (cond
-		((and lo hi
-		      (>= (bound-value lo) -1)
-		      (<= (bound-value hi) 1))
-		 (setf lo (or (bound-func #'acos (numeric-type-high arg)) 0))
-		 (setf hi (or (bound-func #'acos (numeric-type-low arg)) pi))
-		 (specifier-type `(,float-type
-				   ,(and lo (coerce lo float-type))
-				   ,(and hi (coerce hi float-type)))))
-		(t
-		 (float-or-complex-type arg 0 pi)))))
-	   (t
-	    (float-or-complex-type arg 0 pi))))))
-;;;
-(defoptimizer (acos derive-type) ((num))
-  (one-arg-derive-type num #'acos-derive-type-aux #'acos))
-
-
 ;;; Compute bounds for (expt x y).  This should be easy since (expt x
 ;;; y) = (exp (* y (log x))).  However, computations done this way
 ;;; have too much roundoff.  Thus we have to do it the hard way.
@@ -940,7 +898,7 @@
 	 ;; A real raised to a non-integral power can be a float or a
 	 ;; complex number.
 	 (cond ((or (csubtypep x (specifier-type '(rational 0)))
-		    (csubtypep x (specifier-type '(float (0d0)))))
+		    (csubtypep x (specifier-type '(float (0l0)))))
 		;; But a positive real to any power is well-defined.
 		(merged-interval-expt x y))
 	       (t
@@ -959,7 +917,7 @@
   (elfun-derive-type-simple
    x #'log
    (specifier-type
-    #-negative-zero-is-not-zero '(or (member 0f0 0d0) (real (0d0)))
+    #-negative-zero-is-not-zero '(or (member 0f0 0d0) (real (0l0)))
     #+negative-zero-is-not-zero '(real 0d0))
    nil nil))
 
@@ -985,24 +943,26 @@
 
 (defun atan-derive-type-aux-1 (y)
   (elfun-derive-type-simple
-   y #'atan (specifier-type 'real) #.(- (/ pi 2)) #.(/ pi 2)))
+   y #'atan (specifier-type 'real) (- (/ pi 2)) (/ pi 2)))
 
 (defun atan-derive-type-aux-2 (y x same-arg)
   (declare (ignore same-arg))
   ;; The hard case with two args.  We just return the max bounds.
-  (cond ((and (numeric-type-real-p x)
-	      (numeric-type-real-p y))
-	 (make-numeric-type
-	  :class 'float
-	  :format (float-format-max
-		   (numeric-type-format y)
-		   (numeric-type-format x))
-	  :complexp :real
-	  :low #.(- pi)
-	  :high #.pi))
-	(t
-	 ;; The result is a float or a complex number
-	 (float-or-complex-type (numeric-contagion x y)))))
+  (let ((result-type (numeric-contagion y x)))
+    (cond ((and (numeric-type-real-p x)
+		(numeric-type-real-p y))
+	   (let* ((format (case (numeric-type-class result-type)
+			    ((integer rational) 'single-float)
+			    (t (numeric-type-format result-type))))
+		  (bound-format (or format 'float)))
+	     (make-numeric-type :class 'float
+				:format format
+				:complexp :real
+				:low (coerce (- pi) bound-format)
+				:high (coerce pi bound-format))))
+	  (t
+	   ;; The result is a float or a complex number
+	   (float-or-complex-type result-type)))))
 
 (defoptimizer (atan derive-type) ((y &optional x))
   (if x
@@ -1022,50 +982,49 @@
   (one-arg-derive-type num #'cosh-derive-type-aux #'cosh))
 
 
-(defun phase-derive-type-aux (type)
-  (cond ((numeric-type-real-p type)
-	 (case (interval-range-info (numeric-type->interval type) 0.0)
-	   ('+
-	    ;; The number is positive, so the phase is 0.
-	    (make-numeric-type :class 'float
-			       :format (elfun-float-format
-					(numeric-type-format type))
-			       :complexp :real
-			       :low 0
-			       :high 0))
-	   ('-
-	    ;; The number is always negative, so the phase is pi
-	    (make-numeric-type :class 'float
-			       :format (elfun-float-format
-					(numeric-type-format type))
-			       :complexp :real
-			       :low pi
-			       :high pi))
-	   (t
-	    ;; We can't tell.  The result is 0 or pi.  Use a union
-	    ;; type for this
-	    (list
-	     (make-numeric-type :class 'float
-				:format (elfun-float-format
-					 (numeric-type-format type))
-				:complexp :real
-				:low 0
-				:high 0)
-	     (make-numeric-type :class 'float
-				:format (elfun-float-format
-					 (numeric-type-format type))
-				:complexp :real
-				:low pi
-				:high pi)))))
-	(t
-	 ;; We have a complex number.  The answer is the range -pi
-	 ;; to pi.  (-pi is included because we have -0.)
-	 (make-numeric-type :class 'float
-			    :format (elfun-float-format
-				     (numeric-type-format type))
-			    :complexp :real
-			    :low #.(- pi)
-			    :high pi))))
+(defun phase-derive-type-aux (arg)
+  (let* ((format (case (numeric-type-class arg)
+		   ((integer rational) 'single-float)
+		   (t (numeric-type-format arg))))
+	 (bound-type (or format 'float)))
+    (cond ((numeric-type-real-p arg)
+	   (case (interval-range-info (numeric-type->interval arg) 0.0)
+	     ('+
+	      ;; The number is positive, so the phase is 0.
+	      (make-numeric-type :class 'float
+				 :format format
+				 :complexp :real
+				 :low (coerce 0 bound-type)
+				 :high (coerce 0 bound-type)))
+	     ('-
+	      ;; The number is always negative, so the phase is pi
+	      (make-numeric-type :class 'float
+				 :format format
+				 :complexp :real
+				 :low (coerce pi bound-type)
+				 :high (coerce pi bound-type)))
+	     (t
+	      ;; We can't tell.  The result is 0 or pi.  Use a union
+	      ;; type for this
+	      (list
+	       (make-numeric-type :class 'float
+				  :format format
+				  :complexp :real
+				  :low (coerce 0 bound-type)
+				  :high (coerce 0 bound-type))
+	       (make-numeric-type :class 'float
+				  :format format
+				  :complexp :real
+				  :low (coerce pi bound-type)
+				  :high (coerce pi bound-type))))))
+	  (t
+	   ;; We have a complex number.  The answer is the range -pi
+	   ;; to pi.  (-pi is included because we have -0.)
+	   (make-numeric-type :class 'float
+			      :format format
+			      :complexp :real
+			      :low (coerce (- pi) bound-type)
+			      :high (coerce pi bound-type))))))
 
 (defoptimizer (phase derive-type) ((num))
   (one-arg-derive-type num #'phase-derive-type-aux #'phase))
@@ -1085,11 +1044,13 @@
 ;;; should help a lot in optimized code.
 
 (defun realpart-derive-type-aux (type)
+  (let ((class (numeric-type-class type))
+	(format (numeric-type-format type)))
     (cond ((numeric-type-real-p type)
 	   ;; The realpart of a real has the same type and range as
 	   ;; the input.
-	   (make-numeric-type :class (numeric-type-class type)
-			      :format (numeric-type-format type)
+	   (make-numeric-type :class class
+			      :format format
 			      :complexp :real
 			      :low (numeric-type-low type)
 			      :high (numeric-type-high type)))
@@ -1097,33 +1058,36 @@
 	   ;; We have a complex number.  The result has the same type
 	   ;; as the real part, except that it's real, not complex,
 	   ;; obviously.
-	   (make-numeric-type :class (numeric-type-class type)
-			      :format (numeric-type-format type)
+	   (make-numeric-type :class class
+			      :format format
 			      :complexp :real
 			      :low (numeric-type-low type)
-			      :high (numeric-type-high type)))))
+			      :high (numeric-type-high type))))))
 
 (defoptimizer (realpart derive-type) ((num))
   (one-arg-derive-type num #'realpart-derive-type-aux #'realpart))
 
 (defun imagpart-derive-type-aux (type)
-  (cond ((numeric-type-real-p type)
-	 ;; The imagpart of a real has the same type as the input,
-	 ;; except that it's zero
-	 (make-numeric-type :class (numeric-type-class type)
-			    :format (numeric-type-format type)
-			    :complexp :real
-			    :low 0
-			    :high 0))
-	(t
-	 ;; We have a complex number.  The result has the same type as
-	 ;; the imaginary part, except that it's real, not complex,
-	 ;; obviously.
-	 (make-numeric-type :class (numeric-type-class type)
-			    :format (numeric-type-format type)
-			    :complexp :real
-			    :low (numeric-type-low type)
-			    :high (numeric-type-high type)))))
+  (let ((class (numeric-type-class type))
+	(format (numeric-type-format type)))
+    (cond ((numeric-type-real-p type)
+	   ;; The imagpart of a real has the same type as the input,
+	   ;; except that it's zero
+	   (let ((bound-format (or format class 'real)))
+	     (make-numeric-type :class class
+				:format format
+				:complexp :real
+				:low (coerce 0 bound-format)
+				:high (coerce 0 bound-format))))
+	  (t
+	   ;; We have a complex number.  The result has the same type as
+	   ;; the imaginary part, except that it's real, not complex,
+	   ;; obviously.
+	   (make-numeric-type :class class
+			      :format format
+			      :complexp :real
+			      :low (numeric-type-low type)
+			      :high (numeric-type-high type))))))
 
 (defoptimizer (imagpart derive-type) ((num))
   (one-arg-derive-type num #'imagpart-derive-type-aux #'imagpart))
@@ -1235,7 +1199,6 @@
   (frob single-float)
   (frob double-float))
 
-
 ;;; Here are simple optimizers for sin, cos, and tan.  They do not
 ;;; produce a minimal range for the result; the result is the widest
 ;;; possible answer.  This gets around the problem of doing range
@@ -1253,7 +1216,10 @@
 			       :format (numeric-type-format arg)
 			       :complexp :complex))
 	   ((numeric-type-real-p arg)
-	    (let ((float-type (or (numeric-type-format arg) 'float)))
+	    (let* ((format (case (numeric-type-class arg)
+			     ((integer rational) 'single-float)
+			     (t (numeric-type-format arg))))
+		   (bound-type (or format 'float)))
 	      ;; If the argument is a subset of the "principal" domain
 	      ;; of the function, we can compute the bounds because
 	      ;; the function is monotonic.  We can't do this in
@@ -1262,20 +1228,20 @@
 	      ;; exactly the same way as the functions themselves do
 	      ;; it.
 	      (if (csubtypep arg domain)
-		  (let ((lo (bound-func fcn (numeric-type-low arg)))
-			(hi (bound-func fcn (numeric-type-high arg))))
+		  (let ((res-lo (bound-func fcn (numeric-type-low arg)))
+			(res-hi (bound-func fcn (numeric-type-high arg))))
 		    (unless increasingp
-		      (rotatef lo hi))
-	      (specifier-type `(,float-type
-				      ,(or lo *)
-				      ,(or hi *))))
-		  (specifier-type `(,float-type
-				    ,(if def-lo
-					 (coerce def-lo float-type)
-					 '*)
-				    ,(if def-hi
-					 (coerce def-hi float-type)
-					 '*))))))
+		      (rotatef res-lo res-hi))
+		    (make-numeric-type
+		     :class 'float
+		     :format format
+		     :low (coerce-numeric-bound res-lo bound-type)
+		     :high (coerce-numeric-bound res-hi bound-type)))
+		  (make-numeric-type
+		   :class 'float
+		   :format format
+		   :low (and def-lo (coerce def-lo bound-type))
+		   :high (and def-hi (coerce def-hi bound-type))))))
 	   (t
 	    (float-or-complex-type arg def-lo def-hi))))))
 
@@ -1286,7 +1252,7 @@
        ;; Derive the bounds if the arg is in [-pi/2, pi/2]
        (trig-derive-type-aux
 	arg
-	(specifier-type `(float ,#.(- (/ pi 2)) ,#.(/ pi 2)))
+	(specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
 	#'sin
 	-1 1))
    #'sin))
@@ -1297,7 +1263,7 @@
    #'(lambda (arg)
        ;; Derive the bounds if the arg is in [0, pi]
        (trig-derive-type-aux arg
-			     (specifier-type `(float 0d0 ,pi))
+			     (specifier-type `(float 0l0 ,pi))
 			     #'cos
 			     -1 1
 			     nil))
@@ -1309,7 +1275,7 @@
    #'(lambda (arg)
        ;; Derive the bounds if the arg is in [-pi/2, pi/2]
        (trig-derive-type-aux arg
-			     (specifier-type `(float ,#.(- (/ pi 2)) ,#.(/ pi 2)))
+			     (specifier-type `(float ,(- (/ pi 2)) ,(/ pi 2)))
 			     #'tan
 			     nil nil))
    #'tan))
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index 258f4d777..57ea88977 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.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/srctran.lisp,v 1.79 1998/02/13 17:15:08 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.80 1998/02/19 04:28:30 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -260,13 +260,6 @@
 #+propagate-float-type
 (progn
 
-(defun elfun-float-format (format)
-  (if format
-      (if (eq format 'double-float)
-	  'double-float
-	  'single-float)))
-
-  
 ;;; The basic interval type.  It can handle open and closed intervals.
 ;;; A bound is open if it is a list containing a number, just like
 ;;; Lisp says.  NIL means unbounded.
@@ -1495,12 +1488,15 @@
   (cond ((eq (numeric-type-complexp type) :complex)
 	 ;; The absolute value of a complex number is always a
 	 ;; non-negative float.
-	 (make-numeric-type :class 'float
-			    :format (elfun-float-format
-				     (numeric-type-format type))
-			    :complexp :real
-			    :low 0
-			    :high nil))
+	 (let* ((format (case (numeric-type-class type)
+			  ((integer rational) 'single-float)
+			  (t (numeric-type-format type))))
+		(bound-format (or format 'float)))
+	   (make-numeric-type :class 'float
+			      :format format
+			      :complexp :real
+			      :low (coerce 0 bound-format)
+			      :high nil)))
 	(t
 	 ;; The absolute value of a real number is a non-negative real
 	 ;; of the same type.
-- 
GitLab