From e96760613b1d5027c6a0e3a36021bb12efdcf64e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 24 Jun 2010 18:47:42 -0400
Subject: [PATCH] Fixed the optimizer so that it optimizes float comparisons.

original commit: 382a45ad6fe99f758451631b07fac393333893a8
---
 collects/typed-scheme/private/optimize.rkt | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/optimize.rkt b/collects/typed-scheme/private/optimize.rkt
index 6d769493..b77d9802 100644
--- a/collects/typed-scheme/private/optimize.rkt
+++ b/collects/typed-scheme/private/optimize.rkt
@@ -34,7 +34,9 @@
       (dict-set (dict-set h g u) f u))))
 
 (define binary-float-ops 
-  (mk-float-tbl (list #'+ #'- #'* #'/ #'= #'<= #'< #'> #'>= #'min #'max)))
+  (mk-float-tbl (list #'+ #'- #'* #'/ #'min #'max)))
+(define binary-float-comps
+  (mk-float-tbl (list #'= #'<= #'< #'> #'>=)))
 
 (define unary-float-ops
   (mk-float-tbl (list #'abs #'sin #'cos #'tan #'asin #'acos #'atan #'log #'exp
@@ -94,12 +96,21 @@
   ;; unlike their safe counterparts, unsafe binary operators can only take 2 arguments
   (pattern (~and res (#%plain-app (~var op (float-op binary-float-ops)) f1:float-arg-expr f2:float-arg-expr fs:float-arg-expr ...))
            #:when (match (type-of #'res)
+                    ;; if the result is a float, we can coerce integers to floats and optimize
                     [(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 ...))])
                     #`(op.unsafe #,o #,e))))
+  (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps)) f1:float-opt-expr f2:float-opt-expr fs:float-opt-expr ...))
+           #:when (match (type-of #'res)
+                    [(tc-result1: (== -Boolean type-equal?)) #t] [_ #f])
+           #:with opt
+           (begin (log-optimization "binary float comp" #'op)
+                  (for/fold ([o #'f1.opt])
+                      ([e (syntax->list #'(f2.opt fs.opt ...))])
+                    #`(op.unsafe #,o #,e))))
 
   ;; we can optimize exact->inexact if we know we're giving it an Integer
   (pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-opt-expr)