From 85696b0c392ce69e3d6703c4774e9ce9cb4b953e Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Mon, 21 Oct 2013 22:30:45 -0700
Subject: [PATCH] Add missed optimizations for non complexs in complex
 arithmetic.

original commit: 78b9a8a360007eb3bb0ccf658d6ea1e7352791e4
---
 .../typed-racket/optimizer/float-complex.rkt     | 16 +++++++++++++---
 .../typed-racket/optimizer/tests/complex-exp.rkt |  9 +++++----
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
index 6be2f165..21e4ccdd 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/optimizer/float-complex.rkt
@@ -41,6 +41,13 @@
   (log-opt opt-label "Complex number unboxing."))
 (define-syntax-rule (log-arity-raising-opt opt-label)
   (log-opt opt-label arity-raising-opt-msg))
+(define-syntax-rule (log-missed-complex-expr)
+  (log-missed-optimization
+    "Non complex value in complex arithmetic"
+    (string-append
+      "This expression has a non FloatComplex type and thus cannot "
+      "be promoted to unboxed arithmetic.")
+    this-syntax))
 
 ;; If a part is 0.0?
 (define (0.0? stx)
@@ -240,7 +247,8 @@
                         (unsafe-fl* c.imag-binding c.imag-binding))))))
 
   (pattern (#%plain-app op:exp^ c:unboxed-float-complex-opt-expr)
-    #:when (subtypeof? this-syntax -FloatComplex)
+    #:when (or (subtypeof? this-syntax -FloatComplex)
+               (and (log-missed-complex-expr) #f))
     #:with (real-binding imag-binding) (binding-names)
     #:with scaling-factor (generate-temporary "unboxed-scaling-")
     #:do [(log-unboxing-opt "unboxed unary float complex")]
@@ -272,14 +280,16 @@
 
   ;; we can eliminate boxing that was introduced by the user
   (pattern (#%plain-app op:make-rectangular^ real:float-arg-expr imag:float-arg-expr)
-    #:when (subtypeof? this-syntax -FloatComplex)
+    #:when (or (subtypeof? this-syntax -FloatComplex)
+               (and (log-missed-complex-expr) #f))
     #:with (real-binding imag-binding) (binding-names)
     #:do [(log-unboxing-opt "make-rectangular elimination")]
     #:with (bindings ...)
       #'(((real-binding) real.opt)
          ((imag-binding) imag.opt)))
   (pattern (#%plain-app op:make-polar^ r:float-arg-expr theta:float-arg-expr)
-    #:when (subtypeof? this-syntax -FloatComplex)
+    #:when (or (subtypeof? this-syntax -FloatComplex)
+               (and (log-missed-complex-expr) #f))
     #:with radius       (generate-temporary)
     #:with angle        (generate-temporary)
     #:with (real-binding imag-binding) (binding-names)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/complex-exp.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/complex-exp.rkt
index b555f85e..29efe631 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/complex-exp.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/optimizer/tests/complex-exp.rkt
@@ -1,9 +1,10 @@
 #;#;
 #<<END
-TR opt: complex-exp.rkt 15:0 (- (exp 0) 1.0+2.0i) -- unboxed binary float complex
-TR opt: complex-exp.rkt 15:11 1.0+2.0i -- unboxed literal
-TR opt: complex-exp.rkt 15:3 (exp 0) -- float-arg-expr in complex ops
-TR opt: complex-exp.rkt 15:8 0 -- float-arg-expr in complex ops
+TR missed opt: complex-exp.rkt 16:3 (exp 0) -- Non complex value in complex arithmetic
+TR opt: complex-exp.rkt 16:0 (- (exp 0) 1.0+2.0i) -- unboxed binary float complex
+TR opt: complex-exp.rkt 16:11 1.0+2.0i -- unboxed literal
+TR opt: complex-exp.rkt 16:3 (exp 0) -- float-arg-expr in complex ops
+TR opt: complex-exp.rkt 16:8 0 -- float-arg-expr in complex ops
 END
 #<<END
 0.0-2.0i