From 034e27a280ad71220bb9c0a431ade2d1efdf90c7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 17 Jun 2010 19:02:23 -0400
Subject: [PATCH] The optimizer now promotes integers to floats when they are
 used as arguments to a function whose result is a float.

original commit: 5e901b9ef28a9d48f41fb05e7e4be57b34897180
---
 collects/typed-scheme/private/optimize.rkt | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt
index 7d65e5a7..e34c5b65 100644
--- a/collects/typed-scheme/private/optimize.rkt
+++ b/collects/typed-scheme/private/optimize.rkt
@@ -3,7 +3,7 @@
 (require syntax/parse (for-template scheme/base scheme/flonum scheme/unsafe/ops)
          "../utils/utils.rkt" unstable/match scheme/match unstable/syntax
          (rep type-rep)
-         (types abbrev type-table utils))
+         (types abbrev type-table utils subtype))
 (provide optimize)
 
 (define-syntax-class float-opt-expr
@@ -12,6 +12,20 @@
                     [(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
            #:with opt #'e.opt))
 
+;; if the result of an operation is of type float, its non float arguments
+;; can be promoted, and we can use unsafe float operations
+;; note: none of the unary operations have types where non-float arguments
+;;  can result in float (as opposed to real) results
+(define-syntax-class float-arg-expr
+  (pattern e:opt-expr
+           #:when (match (type-of #'e)
+                    [(tc-result1: (== -Integer (lambda (x y) (subtype y x)))) #t] [_ #f])
+           #:with opt #'(->fl e.opt))
+  (pattern e:opt-expr
+           #:when (match (type-of #'e)
+                    [(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
+           #:with opt #'e.opt))
+
 (define-syntax-class float-binary-op
   #:literals (+ - * / = <= < > >= min max
               fl+ fl- fl* fl/ fl= fl<= fl< fl> fl>= flmin flmax)
@@ -63,8 +77,10 @@
            (begin (log-optimization "unary float" #'op)
                   #'(op.unsafe f.opt)))
   ;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
-  (pattern (#%plain-app op:float-binary-op f1:float-opt-expr f2:float-opt-expr fs:float-opt-expr ...)
-           #:with opt 
+  (pattern (~and res (#%plain-app op:float-binary-op f1:float-arg-expr f2:float-arg-expr fs:float-arg-expr ...))
+           #:when (match (type-of #'res)
+                    [(tc-result1: (== -Flonum type-equal?)) #t] [_ #f])
+           #:with opt
            (begin (log-optimization "binary float" #'op)
                   (for/fold ([o #'f1.opt])
                       ([e (syntax->list #'(f2.opt fs.opt ...))])