From 5a0e07e296dc4fbed14fa32571acd866da706eca Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 19 May 2010 16:09:13 -0500
Subject: [PATCH] More precise types for: truncate, floor ceiling

original commit: 230f1a59c6bb51bf69c1651cadb3a77868bcbef5
---
 .../typed-scheme/unit-tests/typecheck-tests.rkt   |  5 ++++-
 .../typed-scheme/private/base-env-numeric.rkt     | 15 ++++++++++++---
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 32e59d56..142385a5 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -790,7 +790,10 @@
         [tc-e (let ()
                 (define: x : Any 7)
                 (if (box? x) (unbox x) (+ 1)))
-              Univ]
+              Univ]        
+        [tc-e (floor 1/2) -Integer]
+        [tc-e (ceiling 1/2) -Integer]
+        [tc-e (truncate 0.5) -Flonum]
         )
   (test-suite
    "check-type tests"
diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index c690abed..853d7a52 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -112,9 +112,18 @@
                  (-Real . -> . -ExactRational)
                  (N . -> . N))]
 
-[floor    (-> -Real -Real)]
-[ceiling  (-> -Real -Real)]
-[truncate (-> -Real -Real)]
+[floor    (cl->*
+           (-> -ExactRational -Integer)
+           (-> -Flonum -Flonum)
+           (-> -Real -Real))]
+[ceiling  (cl->*
+           (-> -ExactRational -Integer)
+           (-> -Flonum -Flonum)
+           (-> -Real -Real))]
+[truncate (cl->*
+           (-> -ExactRational -Integer)
+           (-> -Flonum -Flonum)
+           (-> -Real -Real))]
 [make-rectangular (-Real -Real . -> . N)]
 [make-polar (-Real -Real . -> . N)]
 [real-part (N . -> . -Real)]