From ed8a9d3eef899d06d763840c1013b32ac6acb4fe Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 27 Jun 2011 18:22:58 -0400
Subject: [PATCH] Have a more useful message for float missed opts.

original commit: d68267cbfad06232e146e99dc9a36e296a604a0b
---
 collects/typed-scheme/optimizer/float.rkt | 24 +++++++++++++++--------
 collects/typed-scheme/optimizer/utils.rkt |  8 +++++++-
 2 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 7be4ecc9..1593ef65 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -4,7 +4,7 @@
          racket/dict racket/flonum
          (for-template racket/base racket/flonum racket/unsafe/ops racket/math)
          "../utils/utils.rkt"
-         (types numeric-tower)
+         (types numeric-tower type-table)
          (optimizer utils numeric-utils logging fixnum))
 
 (provide float-opt-expr float-arg-expr)
@@ -74,6 +74,15 @@
   (pattern e:real-expr
            #:with opt #'(exact->inexact e)))
 
+(define (log-float-real-missed-opt stx irritants)
+  (log-missed-optimization
+   (format "This expression has type ~a. It would be better optimized if it had a Float type. To fix this, change the irritant~a to have~a Float type~a."
+           (print-res (type-of stx))
+           (if (> (length irritants) 1) "s" "")
+           (if (> (length irritants) 1) ""  " a")
+           (if (> (length irritants) 1) "s" "")) ; plural
+   stx irritants))
+
 (define-syntax-class float-opt-expr
   #:commit
   (pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-arg-expr)
@@ -81,8 +90,7 @@
                          [missed-optimization? (and (not safe-to-opt?)
                                                     (in-real-layer? this-syntax))])
                     (when missed-optimization?
-                      (log-missed-optimization "unary, arg float-arg-expr, return type not Float"
-                                               this-syntax))
+                      (log-float-real-missed-opt this-syntax (list #'f)))
                     safe-to-opt?)
            #:with opt
            (begin (log-optimization "unary float" this-syntax)
@@ -100,11 +108,11 @@
                          [missed-optimization? (and (not safe-to-opt?)
                                                     (in-real-layer? this-syntax))])
                     (when missed-optimization?
-                      (log-missed-optimization "binary, args all float-arg-expr, return type not Float"
-                                               this-syntax
-                                               (for/list ([x (in-list (syntax->list #'(f1 f2 fs ...)))]
-                                                          #:when (not (subtypeof? x -Flonum)))
-                                                 x)))
+                      (log-float-real-missed-opt
+                       this-syntax
+                       (for/list ([x (in-list (syntax->list #'(f1 f2 fs ...)))]
+                                  #:when (not (subtypeof? x -Flonum)))
+                         x)))
                     ;; If an optimization was expected (whether it was safe or not doesn't matter),
                     ;; report subexpressions doing expensive exact arithmetic (Exact-Rational and
                     ;; Real arithmetic), since that extra precision would be "lost" by going to
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index 3c0cd9b0..e2c94cae 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -12,7 +12,8 @@
          mk-unsafe-tbl
          n-ary->binary
          unboxed-gensym reset-unboxed-gensym
-         optimize)
+         optimize
+         print-res)
 
 ;; if set to #t, the optimizer will dump its result to stdout before compilation
 (define *show-optimized-code* #f)
@@ -51,3 +52,8 @@
 ;; will be set to the actual optimization function at the entry point
 ;; of the optimizer
 (define optimize (make-parameter #f))
+
+(define (print-res t)
+  (match t
+    [(tc-result1: t f o)
+     (format "~a" t)]))