From 6ec1b3686bd5bd79462d4f018fe676fad9ddda8c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 13 Jul 2010 14:09:19 -0400
Subject: [PATCH] Added coercions for floats with unboxed complex operations.

However, this generates superfluous operations involving their
imaginary part of 0.

original commit: 025af5b815503cb4aa64f0a253204016ccba7383
---
 .../typed-scheme/optimizer/inexact-complex.rkt  | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 8c47f7ee..3d65c7d8 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -111,6 +111,14 @@
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c.bindings ...))
                                 (list #'(imag-part (unsafe-fl- 0.0 c.imag-part)))))))
+  (pattern e:expr
+           ;; special handling of inexact reals
+           #:when (subtypeof? #'e -Flonum)
+           #:with real-part (unboxed-gensym)
+           #:with imag-part (unboxed-gensym)
+           #:with (bindings ...)
+           #`((real-part #,((optimize) #'e))
+              (imag-part 0.0)))
   (pattern e:expr
            ;; can't work on inexact reals, which are a subtype of inexact
            ;; complexes, so this has to be equality
@@ -131,7 +139,7 @@
 
 (define-syntax-class inexact-complex-expr
   (pattern e:expr
-           #:when (isoftype? #'e -InexactComplex)
+           #:when (subtypeof? #'e -InexactComplex)
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class inexact-complex-opt-expr
@@ -142,9 +150,10 @@
   (pattern (~and exp (#%plain-app (~or (~var op (float-op binary-inexact-complex-ops))
                                        (~and op (~literal conjugate)))
                                   e:inexact-complex-expr ...))
+           #:when (isoftype? #'exp -InexactComplex)
            #:with exp*:unboxed-inexact-complex-opt-expr #'exp
            #:with opt
            (begin (log-optimization "unboxed inexact complex" #'exp)
-                  (begin (reset-unboxed-gensym)
-                         #'(let* (exp*.bindings ...)
-                             (unsafe-make-flrectangular exp*.real-part exp*.imag-part))))))
+                  (reset-unboxed-gensym)
+                  #'(let* (exp*.bindings ...)
+                      (unsafe-make-flrectangular exp*.real-part exp*.imag-part)))))