From 722040aeed2daaaeb9defe5b364aca92800e0298 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Fri, 5 Dec 1997 16:32:32 +0000
Subject: [PATCH] Update to the derive-type optimizer for the complex function;
 from Raymod Toy.

Backout the calls to float-or-complex-type in the sin and cos
derive-type optimizers, as these gave problems with union types.
---
 compiler/float-tran.lisp | 60 ++++++++++++++++++++++++++++------------
 1 file changed, 42 insertions(+), 18 deletions(-)

diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index 7b615c884..f0d2a241a 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.43 1997/12/04 04:02:16 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.44 1997/12/05 16:32:32 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1141,16 +1141,45 @@
 	    (t
 	     (imagpart-derive type))))))
 
-(defoptimizer (complex derive-type) ((re im))
-  (let* ((re-type (continuation-type re))
-	 (im-type (continuation-type im))
-	 (element-type (numeric-contagion re-type im-type)))
-    ;; Need to check to make sure numeric-contagion returns the right
-    ;; type for what we want here.
-    (make-numeric-type :class (numeric-type-class element-type)
-		       :format (numeric-type-format element-type)
-		       :complexp :complex)))
-			      
+(defoptimizer (complex derive-type) ((re &optional im))
+  (if im
+      (let ((re-type (continuation-type re))
+	    (im-type (continuation-type im)))
+	(if (and (numeric-type-p re-type)
+		 (numeric-type-p im-type))
+	    ;; Need to check to make sure numeric-contagion returns
+	    ;; the right type for what we want here.
+
+	    ;; Also, what about rational canonicalization, like
+	    ;; (complex 5 0) is 5?  So, if the result must be complex,
+	    ;; we make it so.  If the result might be complex, which
+	    ;; happens only if the arguments are rational, we make it
+	    ;; a union type of (or rational (complex rational)).
+	    (let* ((element-type (numeric-contagion re-type im-type))
+		   (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)))))
+		  (make-numeric-type :class (numeric-type-class element-type)
+				     :format (numeric-type-format element-type)
+				     :complexp (if rat-result-p
+						   :real
+						   :complex))))
+	    (specifier-type 'complex)))
+      (let ((re-type (continuation-type re)))
+	(if (numeric-type-p re-type)
+	    (make-numeric-type :class (numeric-type-class re-type)
+			       :format (numeric-type-format re-type)
+			       :complexp (if (csubtypep re-type
+							(specifier-type 'rational))
+					     :real
+					     :complex)
+			       :low (numeric-type-low re-type)
+			       :high (numeric-type-high re-type))
+	    (specifier-type 'complex)))))
+
 (macrolet ((frob (op type)
 	     `(progn
 	       (deftransform ,op ((w z) ((complex ,type) (complex ,type))
@@ -1267,10 +1296,7 @@
    (constantly t)
    #'(lambda (lo hi)
        (declare (ignore lo hi))
-       (values -1d0 1d0))
-   ;; 
-   (float-or-complex-type (continuation-type num)
-			  -1d0 1d0)))
+       (values -1d0 1d0))))
        
 (defoptimizer (cos derive-type) ((num))
   (elfun-derive-type-union
@@ -1278,9 +1304,7 @@
    (constantly t)
    #'(lambda (lo hi)
        (declare (ignore lo hi))
-       (values -1d0 1d0))
-   (float-or-complex-type (continuation-type num)
-			  -1d0 1d0)))
+       (values -1d0 1d0))))
 
 (defoptimizer (tan derive-type) ((num))
   (elfun-derive-type-union
-- 
GitLab