From ca9306bb1d4f14f8ffad4aed66297c88717a650a Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 2 Nov 2015 16:29:58 -0600
Subject: [PATCH] Use more precise notion of "real argument" for multiplication
 too.

Found using random testing.
---
 .../typed-racket/optimizer/float-complex.rkt  | 52 ++++++++++---------
 typed-racket-test/optimizer/known-bugs.rkt    |  2 +-
 .../optimizer/tests/float-complex-float.rkt   |  6 +++
 3 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
index 6801b284..e6e00a0c 100644
--- a/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
+++ b/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
@@ -50,10 +50,6 @@
       "The optimizer could optimize it better if it had type Float-Complex.")
     this-syntax))
 
-;; If a part is 0.0?
-(define (0.0? stx)
-  (equal? (syntax->datum stx) 0.0))
-
 
 ;; a+bi / c+di, names for real and imag parts of result -> one let-values binding clause
 (define (unbox-one-complex-/ a b c d res-real res-imag)
@@ -209,27 +205,33 @@
                                               #'(cs.imag-binding ...))
                                      (list #'imag-binding))]
                          [res '()])
-                (if (null? e1)
-                    (reverse res)
-                    (loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is)
-                          ;; complex multiplication, imag part, then real part (reverse)
-                          ;; we eliminate operations on the imaginary parts of reals
-                          (let ((o-real? (0.0? o2))
-                                (e-real? (0.0? (car e2))))
-                            (list* #`((#,(car is))
-                                      #,(cond ((and o-real? e-real?) #'0.0)
-                                              (o-real? #`(unsafe-fl* #,o1 #,(car e2)))
-                                              (e-real? #`(unsafe-fl* #,o2 #,(car e1)))
-                                              (else
-                                               #`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
-                                                             (unsafe-fl* #,o1 #,(car e2))))))
-                                   #`((#,(car rs))
-                                      #,(cond ((or o-real? e-real?)
-                                               #`(unsafe-fl* #,o1 #,(car e1)))
-                                              (else
-                                               #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
-                                                             (unsafe-fl* #,o2 #,(car e2))))))
-                                 res))))))))
+                (cond
+                 [(null? e1)
+                  (reverse res)]
+                 [else
+                  (define o-real? (syntax-property o2 'was-real?))
+                  (define e-real? (syntax-property (car e2) 'was-real?))
+                  (define both-real? (and o-real? e-real?))
+                  (define new-imag-id (if both-real?
+                                          (syntax-property (car is) 'was-real? #t)
+                                          (car is)))
+                  (loop (car rs) new-imag-id (cdr e1) (cdr e2) (cdr rs) (cdr is)
+                        ;; complex multiplication, imag part, then real part (reverse)
+                        ;; we eliminate operations on the imaginary parts of reals
+                        (list* #`((#,new-imag-id)
+                                  #,(cond ((and o-real? e-real?) #'0.0)
+                                          (o-real? #`(unsafe-fl* #,o1 #,(car e2)))
+                                          (e-real? #`(unsafe-fl* #,o2 #,(car e1)))
+                                          (else
+                                           #`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
+                                                         (unsafe-fl* #,o1 #,(car e2))))))
+                               #`((#,(car rs))
+                                  #,(cond ((or o-real? e-real?)
+                                           #`(unsafe-fl* #,o1 #,(car e1)))
+                                          (else
+                                           #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
+                                                         (unsafe-fl* #,o2 #,(car e2))))))
+                               res))])))))
   (pattern (#%plain-app op:*^ :unboxed-float-complex-opt-expr)
     #:when (subtypeof? this-syntax -FloatComplex)
     #:do [(log-unboxing-opt "unboxed unary float complex")])
diff --git a/typed-racket-test/optimizer/known-bugs.rkt b/typed-racket-test/optimizer/known-bugs.rkt
index dcc0bc2e..72af51c3 100644
--- a/typed-racket-test/optimizer/known-bugs.rkt
+++ b/typed-racket-test/optimizer/known-bugs.rkt
@@ -57,7 +57,7 @@
   (test-suite "Known bugs"
 
     ;; Arguments are converted to inexact too early
-    (bad-opt (* (make-rectangular -inf.0 1) (* 1 1)))
+    (good-opt (* (make-rectangular -inf.0 1) (* 1 1)))
     (good-opt (/ -inf.0-inf.0i 8))
     (good-opt (- (* -1 1 +nan.0) 1.0+1.0i))
     (good-opt (- (* (/ 6 11) (/ 1.2345678f0 123456.7f0)) (make-rectangular 0.0 0.3)))
diff --git a/typed-racket-test/optimizer/tests/float-complex-float.rkt b/typed-racket-test/optimizer/tests/float-complex-float.rkt
index 7ec33915..e3170021 100644
--- a/typed-racket-test/optimizer/tests/float-complex-float.rkt
+++ b/typed-racket-test/optimizer/tests/float-complex-float.rkt
@@ -19,6 +19,10 @@ TR opt: float-complex-float.rkt 5:3 1.0+2.0i -- unboxed literal
 TR opt: float-complex-float.rkt 6:0 (/ 0.0 +inf.0-1.0i) -- unboxed binary float complex
 TR opt: float-complex-float.rkt 6:3 0.0 -- float in complex ops
 TR opt: float-complex-float.rkt 6:7 +inf.0-1.0i -- unboxed literal
+TR opt: float-complex-float.rkt 7:0 (* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541)) -- unboxed binary float complex
+TR opt: float-complex-float.rkt 7:23 3/2 -- non float complex in complex ops
+TR opt: float-complex-float.rkt 7:27 (make-rectangular +inf.f 0.7692234292042541) -- make-rectangular elimination
+TR opt: float-complex-float.rkt 7:3 -0.9263371220283309 -- float in complex ops
 END
 #<<END
 6.0+8.0i
@@ -26,6 +30,7 @@ END
 -4.0-4.0i
 -4.0-2.0i
 +nan.0+0.0i
+-inf.0-1.0688403264087485i
 
 END
 #lang typed/scheme
@@ -37,3 +42,4 @@ END
 (- 1.0+2.0i 2.0 3.0+6.0i)
 (- 1.0+2.0i 2.0+4.0i 3.0)
 (/ 0.0 +inf.0-1.0i)
+(* -0.9263371220283309 3/2 (make-rectangular +inf.f 0.7692234292042541))