From 4d24cbee606b19dea77d7225fba4517957d6fc0a Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 29 Apr 2011 15:25:38 -0400
Subject: [PATCH] Promote more literals at compile-time.

---
 .../optimizer/tests/invalid-float-promotion.rkt           | 3 +++
 .../typed-scheme/optimizer/tests/rational-literal.rkt     | 8 ++++++++
 collects/typed-scheme/optimizer/float.rkt                 | 5 +++--
 3 files changed, 14 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
index 03a112b1bc..a4a20f6e46 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
@@ -1,8 +1,11 @@
 #;
 (
 0.5
+2.0
 )
 
 #lang typed/scheme
 #:optimize
+;; the ann are necessary, since (* PosReal Float) -> Float (exact 0 is not in PosReal)
 (/ (ann 1 Integer) 2.0) ; result is not a float, can't optimize
+(* (ann 2/3 Exact-Rational) 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt b/collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt
new file mode 100644
index 0000000000..d6250d7e19
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/rational-literal.rkt
@@ -0,0 +1,8 @@
+#;
+(
+rational-literal.rkt line 8 col 1 - + - binary float
+1.95
+)
+#lang typed/racket #:optimize
+;; rational literals should be promoted to floats at compile time
+(+ 3/4 1.2)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 3b278de2d4..13b51f7e4f 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -67,9 +67,10 @@
   #:commit
   ;; we can convert literals right away
   (pattern (quote n)
-           #:when (exact-integer? (syntax->datum #'n))
+           #:when (and (real?  (syntax->datum #'n))
+                       (exact? (syntax->datum #'n)))
            #:with opt
-           (datum->syntax #'here (->fl (syntax->datum #'n))))
+           (datum->syntax #'here (exact->inexact (syntax->datum #'n))))
   (pattern e:fixnum-expr
            #:with opt #'(unsafe-fx->fl e.opt))
   (pattern e:int-expr