From f5e1e7bbfde342dc99e15fa6992ea52bc98860db Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Nov 2012 18:11:56 -0500
Subject: [PATCH] Refactor arithmetic hidden cost logging.

original commit: 50777aaca4b580173c9f618f9c2f65fd9463dc8c
---
 collects/typed-racket/optimizer/float.rkt | 26 +++++++++++------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/collects/typed-racket/optimizer/float.rkt b/collects/typed-racket/optimizer/float.rkt
index 17c341b3..2c5c7d9a 100644
--- a/collects/typed-racket/optimizer/float.rkt
+++ b/collects/typed-racket/optimizer/float.rkt
@@ -261,33 +261,33 @@
                   #'(unsafe-fl- n.opt 1.0)))
 
   ;; warn about (potentially) exact real arithmetic, in general
+  ;; Note: These patterns don't perform optimization. They only produce logging
+  ;;  for consumption by Optimization Coach.
   (pattern (#%plain-app (~var op (float-op binary-float-ops))
                         n ...)
-           #:when (and (subtypeof? this-syntax -Real)
-                       (not (subtypeof? this-syntax -Flonum))
-                       (not (subtypeof? this-syntax -Int)))
+           #:when (maybe-exact-rational? this-syntax)
            #:with opt
            (begin (log-optimization-info "exact real arith"
                                          this-syntax)
-                  this-syntax)) ; no change
+                  this-syntax))
   (pattern (#%plain-app (~var op (float-op binary-float-comps))
                         n ...)
            ;; can't look at return type, since it's always bool
-           #:when (for/and ([arg (syntax->list #'(n ...))])
-                    (and (subtypeof? arg -Real)
-                         (not (subtypeof? arg -Flonum))
-                         (not (subtypeof? arg -Int))))
+           #:when (andmap maybe-exact-rational? (syntax->list #'(n ...)))
            #:with opt
            (begin (log-optimization-info "exact real arith"
                                          this-syntax)
-                  this-syntax)) ; no change
+                  this-syntax))
   (pattern (#%plain-app (~var op (float-op unary-float-ops))
                         n ...)
-           #:when (and (subtypeof? this-syntax -Real)
-                       (not (subtypeof? this-syntax -Flonum))
-                       (not (subtypeof? this-syntax -Int)))
+           #:when (maybe-exact-rational? this-syntax)
            #:with opt
            (begin (log-optimization-info "exact real arith"
                                          this-syntax)
-                  this-syntax)) ; no change
+                  this-syntax))
   )
+
+(define (maybe-exact-rational? stx)
+  (and (subtypeof? stx -Real)
+       (not (subtypeof? stx -Flonum))
+       (not (subtypeof? stx -Int))))