From 69b3ea5f28e6935e96acf71d9850d663fa1b14c2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 2 May 2011 10:46:49 -0400
Subject: [PATCH] First attempt at logging unexpected Real types popping up.

original commit: 7b2c6f5765c2f3b5aefd24f15bbd6f9bf5855749
---
 .../optimizer/close-calls/real-in-float-expr.rkt   | 14 ++++++++++++++
 collects/typed-scheme/optimizer/float.rkt          |  9 ++++++++-
 2 files changed, 22 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/close-calls/real-in-float-expr.rkt

diff --git a/collects/tests/typed-scheme/optimizer/close-calls/real-in-float-expr.rkt b/collects/tests/typed-scheme/optimizer/close-calls/real-in-float-expr.rkt
new file mode 100644
index 00000000..b97b60f4
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/close-calls/real-in-float-expr.rkt
@@ -0,0 +1,14 @@
+#;
+(
+ real-in-float-expr.rkt line 10 col 0 - (#%app * (quote 3) (quote 2.3)) - binary, args all float-arg-expr, return type not Float
+ 6.8999999999999995
+ 6
+ 5
+ )
+#lang typed/racket
+
+(* (ann 3 Real) ; with type Real, typechecker must assume it could be exact 0
+   2.3)
+
+(* (ann 2 Integer) (ann 3 Integer)) ; but these have nothing to do with floats, should not be logged
+(+ (ann 2 Integer) (ann 3 Integer))
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index f77e4251..50323c93 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -86,7 +86,14 @@
                         f2:float-arg-expr
                         fs:float-arg-expr ...)
            ;; if the result is a float, we can coerce integers to floats and optimize
-           #:when (subtypeof? this-syntax -Flonum)
+           #:when (let ([safe-to-opt? (subtypeof? this-syntax -Flonum)])
+                    ;; if we don't have a return type of float, we missed an optimization
+                    ;; opportunity, report it
+                    (when (and (not safe-to-opt?)
+                               (isoftype? this-syntax -Real))
+                      (log-close-call "binary, args all float-arg-expr, return type not Float"
+                                      this-syntax))
+                    safe-to-opt?)
            #:with opt
            (begin (log-optimization "binary float" #'op)
                   (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))