From a713ca8a8b6c7aed987e80d0621484e68bc3c6f5 Mon Sep 17 00:00:00 2001
From: Neil Toronto <ntoronto@racket-lang.org>
Date: Tue, 5 Jun 2012 22:40:44 -0600
Subject: [PATCH] Added nan?, infinite?, degrees->radians, radians->degrees,
 exact-round, exact-floor, exact-ceiling, exact-truncate to racket/math

Altered TR's random arithmetic testing to generate single-flonums and very small flonums; fails now because of erroneous types

Fixes to sgn, sinh, cosh, and tanh:
 * preserve single-flonum-ness
 * correct zero sign (-0.0) for negative return values that are smaller than epsilon
 * correct behavior with NaN and infinite inputs
---
 collects/mrlib/image-core.rkt                 |   3 -
 collects/plot/common/math.rkt                 |  32 +-
 collects/plot/contracted/math.rkt             |   4 +-
 collects/plot/scribblings/utils.scrbl         |  20 -
 collects/racket/math.rkt                      | 121 +++--
 collects/tests/racket/math.rktl               | 433 +++++++++++++++++-
 .../tests/typed-racket/tr-random-testing.rkt  |  29 +-
 .../base-env/base-env-numeric.rkt             |   3 +-
 8 files changed, 554 insertions(+), 91 deletions(-)

diff --git a/collects/mrlib/image-core.rkt b/collects/mrlib/image-core.rkt
index 7da15b38a2..b047b8ab64 100644
--- a/collects/mrlib/image-core.rkt
+++ b/collects/mrlib/image-core.rkt
@@ -1132,9 +1132,6 @@ the mask bitmap and the original bitmap are all together in a single bytes!
        (values (abs rotated-width)
                (abs rotated-height)))]))
 
-(define (degrees->radians θ)
-  (* θ 2 pi (/ 360)))
-
 (define (mode-color->smoothing mode color)
   (cond
     [(and (eq? mode 'outline)
diff --git a/collects/plot/common/math.rkt b/collects/plot/common/math.rkt
index c9eaf7083e..fe86d4e275 100644
--- a/collects/plot/common/math.rkt
+++ b/collects/plot/common/math.rkt
@@ -1,6 +1,7 @@
 #lang racket
 
-(require racket/contract racket/unsafe/ops unstable/flonum unstable/latent-contract/defthing)
+(require racket/contract racket/unsafe/ops
+         unstable/flonum unstable/latent-contract/defthing)
 
 (provide (all-defined-out))
 
@@ -13,12 +14,6 @@
 ;; ===================================================================================================
 ;; Flonums
 
-(defproc (nan? [x any/c]) boolean?
-  (eqv? x +nan.0))
-
-(defproc (infinite? [x any/c]) boolean?
-  (and (flonum? x) (or (unsafe-fl= x +inf.0) (unsafe-fl= x -inf.0))))
-
 (defproc (flblend [x flonum?] [y flonum?] [α flonum?]) flonum?
   (cond [(not (flonum? x))  (raise-type-error 'flblend "flonum" 0 x y α)]
         [(not (flonum? y))  (raise-type-error 'flblend "flonum" 1 x y α)]
@@ -121,17 +116,6 @@
                               (cond [(real? y)  (max2* m y)]
                                     [else  (apply raise-type-error 'max* "real number" i x xs)]))])]))
 
-(define 180/pi (/ 180 pi))
-(define pi/180 (/ pi 180))
-
-(defproc (degrees->radians [d real?]) real?
-  (cond [(not (real? d))  (raise-type-error 'degrees->radians "real number" d)]
-        [else  (* d pi/180)]))
-
-(defproc (radians->degrees [r real?]) real?
-  (cond [(not (real? r))  (raise-type-error 'radians->degrees "real number" r)]
-        [else  (* r 180/pi)]))
-
 (defproc (blend [x real?] [y real?] [α real?]) real?
   (cond [(not (real? x))  (raise-type-error 'blend "real number" 0 x y α)]
         [(not (real? y))  (raise-type-error 'blend "real number" 1 x y α)]
@@ -475,17 +459,21 @@
   (if x (if y (max* x y) x)
       (if y y #f)))
 
+(define (maybe-real? x)
+  (or (real? x) (not x)))
+
 (struct ivl (min max) #:transparent
   #:guard (λ (a b _)
-            (cond [(or (nan? a) (nan? b))  (values +nan.0 +nan.0)]
-                  [(and a b)               (values (min* a b) (max* a b))]
-                  [else                    (values a b)])))
+            (cond [(or (and a (nan? a)) (and b (nan? b)))  (values +nan.0 +nan.0)]
+                  [(and a b)  (values (min* a b) (max* a b))]
+                  [else  (values a b)])))
 
 (defthing empty-ivl ivl? (ivl +nan.0 +nan.0))
 (defthing unknown-ivl ivl? (ivl #f #f))
 
 (defproc (ivl-empty? [i ivl?]) boolean?
-  (nan? (ivl-min i)))
+  (define a (ivl-min i))
+  (and a (nan? a)))
 
 (defproc (ivl-known? [i ivl?]) boolean?
   (match-define (ivl a b) i)
diff --git a/collects/plot/contracted/math.rkt b/collects/plot/contracted/math.rkt
index 5a234e2173..7cecd31872 100644
--- a/collects/plot/contracted/math.rkt
+++ b/collects/plot/contracted/math.rkt
@@ -5,10 +5,10 @@
 (require "../common/math.rkt")
 (provide equal?*
          ;; Flonums
-         nan? infinite? flblend flsum fldistance (activate-contract-out flonum-ok-for-range?)
+         flblend flsum fldistance (activate-contract-out flonum-ok-for-range?)
          ;; Reals
          maybe-inexact->exact
-         min* max* degrees->radians radians->degrees blend atan2 sum real-modulo distance
+         min* max* blend atan2 sum real-modulo distance
          floor-log/base ceiling-log/base
          polar->cartesian 3d-polar->3d-cartesian
          ;; Vectors
diff --git a/collects/plot/scribblings/utils.scrbl b/collects/plot/scribblings/utils.scrbl
index 866c6d7db6..ef1839c663 100644
--- a/collects/plot/scribblings/utils.scrbl
+++ b/collects/plot/scribblings/utils.scrbl
@@ -238,14 +238,6 @@ Integer brush styles repeat starting at @(racket 7).
 @;----------------------------------------------------------------------------------------------------
 @subsection{Real Functions}
 
-@doc-apply[degrees->radians]{
-Converts degrees to radians.
-}
-
-@doc-apply[radians->degrees]{
-Converts radians to degrees.
-}
-
 @doc-apply[polar->cartesian]{
 Converts 2D polar coordinates to 3D cartesian coordinates.
 }
@@ -255,18 +247,6 @@ Converts 3D polar coordinates to 3D cartesian coordinates.
 See @racket[parametric3d] for an example of use.
 }
 
-@doc-apply[infinite?]{
-Returns @racket[#t] if @racket[x] is either @racket[+inf.0] or @racket[-inf.0].
-@examples[#:eval plot-eval
-                 (map infinite? (list +inf.0 -inf.0 0 'bob))]
-}
-
-@doc-apply[nan?]{
-Returns @racket[#t] if @racket[x] is @racket[+nan.0].
-@examples[#:eval plot-eval
-                 (map nan? (list +nan.0 +inf.0 0 'bob))]
-}
-
 @doc-apply[ceiling-log/base]{
 Like @racket[(ceiling (/ (log x) (log b)))], but @racket[ceiling-log/base] is not susceptible to floating-point error.
 @examples[#:eval plot-eval
diff --git a/collects/racket/math.rkt b/collects/racket/math.rkt
index 0065cfefb9..c6235be0f6 100644
--- a/collects/racket/math.rkt
+++ b/collects/racket/math.rkt
@@ -4,42 +4,105 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 #lang racket/base
-(provide pi
+
+(require "unsafe/ops.rkt"
+         "performance-hint.rkt")
+
+(provide pi pi.f
+         nan? infinite?
          sqr
          sgn conjugate
          sinh cosh tanh
+         degrees->radians radians->degrees
+         exact-round exact-floor exact-ceiling exact-truncate
          order-of-magnitude)
 
-(define (sqr z)
-  (unless (number? z) (raise-argument-error 'sqr "number?" z))
-  (* z z))
-
 (define pi (atan 0 -1))
+(define pi.f (atan 0.0f0 -1.0f0))
 
-;; sgn function
-(define (sgn x)
-  (unless (real? x) (raise-argument-error 'sgn "real?" x))
-  (if (exact? x)
-    (cond [(< x 0) -1] [(> x 0) 1] [else 0])
-    (cond [(< x 0.0) -1.0] [(> x 0.0) 1.0] [else 0.0])))
-
-;; complex conjugate
-(define (conjugate z)
-  (unless (number? z) (raise-argument-error 'conjugate "number?" z))
-  (make-rectangular (real-part z) (- (imag-part z))))
-
-;; real hyperbolic functions
-(define (sinh x)
-  (unless (number? x) (raise-argument-error 'sinh "number?" x))
-  (/ (- (exp x) (exp (- x))) 2.0))
-
-(define (cosh x)
-  (unless (number? x) (raise-argument-error 'cosh "number?" x))
-  (/ (+ (exp x) (exp (- x))) 2.0))
-
-(define (tanh x)
-  (unless (number? x) (raise-argument-error 'tanh "number?" x))
-  (/ (sinh x) (cosh x)))
+(begin-encourage-inline
+  
+  ;; real predicates
+  (define (nan? x)
+    (unless (real? x) (raise-argument-error 'nan? "real?" x))
+    (or (eqv? x +nan.0) (eqv? x +nan.f)))
+  
+  (define (infinite? x)
+    (unless (real? x) (raise-argument-error 'infinite? "real?" x))
+    (or (= x +inf.0) (= x -inf.0)))
+  
+  ;; z^2
+  (define (sqr z)
+    (unless (number? z) (raise-argument-error 'sqr "number?" z))
+    (* z z))
+  
+  ;; sgn function
+  (define (sgn x)
+    (unless (real? x) (raise-argument-error 'sgn "real?" x))
+    (cond [(= 0 x)   x]  ; preserve 0, 0.0 and 0.0f0
+          [(double-flonum? x)  (cond [(unsafe-fl> x 0.0)  1.0]
+                                     [(unsafe-fl< x 0.0) -1.0]
+                                     [else  +nan.0])]
+          [(single-flonum? x)  (cond [(> x 0.0f0)  1.0f0]
+                                     [(< x 0.0f0) -1.0f0]
+                                     [else  +nan.f])]
+          [else  (if (> x 0) 1 -1)]))
+  
+  ;; complex conjugate
+  (define (conjugate z)
+    (unless (number? z) (raise-argument-error 'conjugate "number?" z))
+    (make-rectangular (real-part z) (- (imag-part z))))
+  
+  ;; complex hyperbolic functions
+  (define (sinh z)
+    (unless (number? z) (raise-argument-error 'sinh "number?" z))
+    (cond [(real? z)
+           (let loop ([z z])
+             (cond [(z . < . 0)  (- (loop (- z)))]
+                   [else  (/ (- (exp z) (exp (- z))) 2)]))]
+          [else  (/ (- (exp z) (exp (- z))) 2)]))
+  
+  (define (cosh z)
+    (unless (number? z) (raise-argument-error 'cosh "number?" z))
+    (/ (+ (exp z) (exp (- z))) 2))
+  
+  (define (tanh z)
+    (unless (number? z) (raise-argument-error 'tanh "number?" z))
+    (cond [(= z 0)  z]  ; preserve 0, 0.0, -0.0, 0.0f0, 0.0+0.0i, etc.
+          [(real? z)
+           (let loop ([z z])
+             (cond [(z . < . 0)  (- (loop (- z)))]
+                   [(z . < . 20)  (define exp2z (exp (* 2 z)))
+                                  (/ (- exp2z 1) (+ exp2z 1))]
+                   [(z . >= . 20)  (if (single-flonum? z) 1.0f0 1.0)]
+                   [else  z]))]  ; +nan.0 or +nan.f
+          [else
+           (define exp2z (exp (* 2 z)))
+           (/ (- exp2z 1) (+ exp2z 1))]))
+  
+  ;; angle conversion
+  (define (degrees->radians x)
+    (unless (real? x) (raise-argument-error 'degrees->radians "real?" x))
+    (cond [(single-flonum? x)  (* x (/ pi.f 180f0))]
+          [else  (* x (/ pi 180.0))]))
+  
+  (define (radians->degrees x)
+    (unless (real? x) (raise-argument-error 'radians->degrees "real?" x))
+    (cond [(single-flonum? x)  (* x (/ 180f0 pi.f))]
+          [else  (* x (/ 180.0 pi))]))
+  
+  ;; inexact->exact composed with round, floor, ceiling, truncate
+  (define-syntax-rule (define-integer-conversion name convert)
+    (define (name x)
+      (unless (real? x) (raise-argument-error 'name "real?" x))
+      (inexact->exact (convert x))))
+  
+  (define-integer-conversion exact-round round)
+  (define-integer-conversion exact-floor floor)
+  (define-integer-conversion exact-ceiling ceiling)
+  (define-integer-conversion exact-truncate truncate)
+  
+  )  ; begin-encourage-inline
 
 (define order-of-magnitude
   (let* ([exact-log (λ (x) (inexact->exact (log x)))]
diff --git a/collects/tests/racket/math.rktl b/collects/tests/racket/math.rktl
index 62c3b93de9..60207a3567 100644
--- a/collects/tests/racket/math.rktl
+++ b/collects/tests/racket/math.rktl
@@ -1,6 +1,426 @@
 (load-relative "loadtest.rktl")
 (Section 'math)
-(require scheme/math)
+(require scheme/math
+         racket/flonum
+         unstable/flonum)
+
+(define (double=? x y)
+  (and (flonum? y)
+       (let ([x  (inexact->exact x)]
+             [y  (inexact->exact y)])
+         ((abs (- x y)) . < . #e1e-10))))
+
+(define (single=? x y)
+  (and (single-flonum? y)
+       (let ([x  (inexact->exact x)]
+             [y  (inexact->exact y)])
+         ((abs (- x y)) . < . #e1e-6))))
+
+;; =========================================================================
+;; pi
+
+(test #t single=? #e3.141592653589793238462643383279502884197169399 pi.f)
+(test #t double=? #e3.141592653589793238462643383279502884197169399 pi)
+(test pi.f real->single-flonum pi)
+
+;; =========================================================================
+;; nan?
+
+(test #f nan? -1)
+(test #f nan? 0)
+(test #f nan? 1)
+
+(test #t nan? +nan.f)
+(test #f nan? -inf.f)
+(test #f nan? -1.0f0)
+(test #f nan? -0.0f0)
+(test #f nan? 0.0f0)
+(test #f nan? 1.0f0)
+(test #f nan? +inf.f)
+
+(test #t nan? +nan.0)
+(test #f nan? -inf.0)
+(test #f nan? -max.0)
+(test #f nan? -1.0)
+(test #f nan? -min.0)
+(test #f nan? -0.0)
+(test #f nan? 0.0)
+(test #f nan? +min.0)
+(test #f nan? 1.0)
+(test #f nan? +max.0)
+(test #f nan? +inf.0)
+
+;; =========================================================================
+;; infinite?
+
+(test #f infinite? -1)
+(test #f infinite? 0)
+(test #f infinite? 1)
+
+(test #f infinite? +nan.f)
+(test #t infinite? -inf.f)
+(test #f infinite? -1.0f0)
+(test #f infinite? -0.0f0)
+(test #f infinite? 0.0f0)
+(test #f infinite? 1.0f0)
+(test #t infinite? +inf.f)
+
+(test #f infinite? +nan.0)
+(test #t infinite? -inf.0)
+(test #f infinite? -max.0)
+(test #f infinite? -1.0)
+(test #f infinite? -min.0)
+(test #f infinite? -0.0)
+(test #f infinite? 0.0)
+(test #f infinite? +min.0)
+(test #f infinite? 1.0)
+(test #f infinite? +max.0)
+(test #t infinite? +inf.0)
+
+;; =========================================================================
+;; sqr
+
+(test 4 sqr -2)
+(test 1 sqr -1)
+(test 0 sqr 0)
+(test 1 sqr 1)
+(test 4 sqr 2)
+
+(test +nan.f sqr +nan.f)
+(test +inf.f sqr -inf.f)
+(test 4.0f0 sqr -2.0f0)
+(test 1.0f0 sqr -1.0f0)
+(test 0.0f0 sqr -0.0f0)
+(test 0.0f0 sqr 0.0f0)
+(test 1.0f0 sqr 1.0f0)
+(test 4.0f0 sqr 2.0f0)
+(test +inf.f sqr +inf.f)
+
+(test +nan.0 sqr +nan.0)
+(test +inf.0 sqr -inf.0)
+(test +inf.0 sqr -max.0)
+(test 4.0 sqr -2.0)
+(test 1.0 sqr -1.0)
+(test 0.0 sqr -min.0)
+(test 0.0 sqr -0.0)
+(test 0.0 sqr 0.0)
+(test 0.0 sqr +min.0)
+(test 1.0 sqr 1.0)
+(test 4.0 sqr 2.0)
+(test +inf.0 sqr +max.0)
+(test +inf.0 sqr +inf.0)
+
+;; =========================================================================
+;; sgn
+
+(test -1 sgn -2)
+(test -1 sgn -1)
+(test 0 sgn 0)
+(test 1 sgn 1)
+(test 1 sgn 2)
+
+(test +nan.f sgn +nan.f)
+(test -1.0f0 sgn -inf.f)
+(test -1.0f0 sgn -1.0f0)
+(test -0.0f0 sgn -0.0f0)
+(test 0.0f0 sgn 0.0f0)
+(test 1.0f0 sgn 1.0f0)
+(test 1.0f0 sgn +inf.f)
+
+(test +nan.0 sgn +nan.0)
+(test -1.0 sgn -inf.0)
+(test -1.0 sgn -max.0)
+(test -1.0 sgn -1.0)
+(test -1.0 sgn -min.0)
+(test -0.0 sgn -0.0)
+(test 0.0 sgn 0.0)
+(test 1.0 sgn +min.0)
+(test 1.0 sgn 1.0)
+(test 1.0 sgn +max.0)
+(test 1.0 sgn +inf.0)
+
+;; =========================================================================
+;; sinh
+
+(define sinh+1 1.1752011936438014568823818505956008151557179813341)
+(define sinh-1 (- sinh+1))
+
+(test #t double=? sinh-1 (sinh -1))
+(test 0 sinh 0)
+(test #t double=? sinh+1 (sinh 1))
+
+(test +nan.f sinh +nan.f)
+(test -inf.f sinh -inf.f)
+(test #t single=? sinh-1 (sinh -1.0f0))
+(test 0.0f0 sinh 0.0f0)
+(test #t single=? sinh+1 (sinh 1.0f0))
+(test +inf.f sinh +inf.f)
+
+(test +nan.0 sinh +nan.0)
+(test -inf.0 sinh -inf.0)
+(test -inf.0 sinh -max.0)
+(test #t double=? sinh-1 (sinh -1.0))
+(test -0.0 sinh -min.0)
+(test -0.0 sinh -0.0)
+(test 0.0 sinh 0.0)
+(test 0.0 sinh +min.0)
+(test #t double=? sinh+1 (sinh 1.0))
+(test +inf.0 sinh +max.0)
+(test +inf.0 sinh +inf.0)
+
+;; =========================================================================
+;; cosh
+
+(define cosh+1 #e1.5430806348152437784779056207570616826015291123659)
+
+(test #t double=? cosh+1 (cosh -1))
+(test 1 cosh 0)
+(test #t double=? cosh+1 (cosh 1))
+
+(test +nan.f cosh +nan.f)
+(test +inf.f cosh -inf.f)
+(test #t single=? cosh+1 (cosh -1.0f0))
+(test 1.0f0 cosh -0.0f0)
+(test 1.0f0 cosh 0.0f0)
+(test #t single=? cosh+1 (cosh 1.0f0))
+(test +inf.f cosh +inf.f)
+
+(test +nan.0 cosh +nan.0)
+(test +inf.0 cosh -inf.0)
+(test +inf.0 cosh -max.0)
+(test #t double=? cosh+1 (cosh -1.0))
+(test 1.0 cosh -min.0)
+(test 1.0 cosh -0.0)
+(test 1.0 cosh 0.0)
+(test 1.0 cosh +min.0)
+(test #t double=? cosh+1 (cosh 1.0))
+(test +inf.0 cosh +max.0)
+(test +inf.0 cosh +inf.0)
+
+;; =========================================================================
+;; tanh
+
+(define tanh+1 #e0.76159415595576488811945828260479359041276859725794)
+(define tanh-1 (- tanh+1))
+
+(test -1.0 tanh -20)
+(test #t double=? tanh-1 (tanh -1))
+(test 0 tanh 0)
+(test #t double=? tanh+1 (tanh 1))
+(test 1.0 tanh 20)
+
+(test +nan.f tanh +nan.f)
+(test -1.0f0 tanh -inf.f)
+(test -1.0f0 tanh -20.0f0)
+(test #t single=? tanh-1 (tanh -1.0f0))
+(test -0.0f0 tanh -0.0f0)
+(test 0.0f0 tanh 0.0f0)
+(test #t single=? tanh+1 (tanh 1.0f0))
+(test 1.0f0 tanh 20.0f0)
+(test 1.0f0 tanh +inf.f)
+
+(test +nan.0 tanh +nan.0)
+(test -1.0 tanh -inf.0)
+(test -1.0 tanh -max.0)
+(test -1.0 tanh -20.0)
+(test #t double=? tanh-1 (tanh -1.0))
+(test -0.0 tanh -min.0)
+(test -0.0 tanh -0.0)
+(test 0.0 tanh 0.0)
+(test 0.0 tanh +min.0)
+(test #t double=? tanh+1 (tanh 1.0))
+(test 1.0 tanh 20.0)
+(test 1.0 tanh +max.0)
+(test 1.0 tanh +inf.0)
+
+;; =========================================================================
+;; degrees->radians
+
+(test #t double=? (- pi) (degrees->radians -180))
+(test #t double=? (* -1/2 pi) (degrees->radians -90))
+(test 0 degrees->radians 0)
+(test #t double=? (* 1/2 pi) (degrees->radians 90))
+(test #t double=? pi (degrees->radians 180))
+
+(test +nan.f degrees->radians +nan.f)
+(test -inf.f degrees->radians -inf.f)
+(test #t single=? (- pi) (degrees->radians -180.0f0))
+(test #t single=? (* -1/2 pi) (degrees->radians -90.0f0))
+(test -0.0f0 degrees->radians -0.0f0)
+(test 0.0f0 degrees->radians 0.0f0)
+(test #t single=? (* 1/2 pi) (degrees->radians 90.0f0))
+(test #t single=? pi (degrees->radians 180.0f0))
+(test +inf.f degrees->radians +inf.f)
+
+(test +nan.0 degrees->radians +nan.0)
+(test -inf.0 degrees->radians -inf.0)
+(test #t double=? (- pi) (degrees->radians -180.0))
+(test #t double=? (* -1/2 pi) (degrees->radians -90.0))
+(test -0.0 degrees->radians -min.0)
+(test -0.0 degrees->radians -0.0)
+(test 0.0 degrees->radians 0.0)
+(test 0.0 degrees->radians +min.0)
+(test #t double=? (* 1/2 pi) (degrees->radians 90.0))
+(test #t double=? pi (degrees->radians 180.0))
+(test +inf.0 degrees->radians +inf.0)
+
+;; =========================================================================
+;; radians->degrees
+
+(test 0 radians->degrees 0)
+
+(test +nan.f radians->degrees +nan.f)
+(test -inf.f radians->degrees -inf.f)
+(test #t single=? -180 (radians->degrees (- pi.f)))
+(test #t single=? -90 (radians->degrees (* -1/2 pi.f)))
+(test -0.0f0 radians->degrees -0.0f0)
+(test 0.0f0 radians->degrees 0.0f0)
+(test #t single=? 90 (radians->degrees (* 1/2 pi.f)))
+(test #t single=? 180 (radians->degrees pi.f))
+(test +inf.f radians->degrees +inf.f)
+
+(test +nan.0 radians->degrees +nan.0)
+(test -inf.0 radians->degrees -inf.0)
+(test -inf.0 radians->degrees -max.0)
+(test #t double=? -180 (radians->degrees (- pi)))
+(test #t double=? -90 (radians->degrees (* -1/2 pi)))
+(test -0.0 radians->degrees -0.0)
+(test 0.0 radians->degrees 0.0)
+(test #t double=? 90 (radians->degrees (* 1/2 pi)))
+(test #t double=? 180 (radians->degrees pi))
+(test +inf.0 radians->degrees +max.0)
+(test +inf.0 radians->degrees +inf.0)
+
+;; =========================================================================
+;; exact-round
+
+(test -2 exact-round #e-1.5)
+(test 0 exact-round #e-0.5)
+(test 0 exact-round #e0.5)
+(test 2 exact-round #e1.5)
+
+(err/rt-test (exact-round +nan.f))
+(err/rt-test (exact-round -inf.f))
+(test -2 exact-round -1.5f0)
+(test 0 exact-round -0.5f0)
+(test 0 exact-round 0.5f0)
+(test 2 exact-round 1.5f0)
+(err/rt-test (exact-round +inf.f))
+
+(err/rt-test (exact-round +nan.0))
+(err/rt-test (exact-round -inf.0))
+(test (inexact->exact -max.0) exact-round -max.0)
+(test -2 exact-round -1.5)
+(test 0 exact-round -0.5)
+(test 0 exact-round -min.0)
+(test 0 exact-round +min.0)
+(test 0 exact-round 0.5)
+(test 2 exact-round 1.5)
+(test (inexact->exact +max.0) exact-round +max.0)
+(err/rt-test (exact-round +inf.0))
+
+;; =========================================================================
+;; exact-floor
+
+(test -2 exact-floor #e-1.5)
+(test -1 exact-floor #e-0.5)
+(test 0 exact-floor #e0.5)
+(test 1 exact-floor #e1.5)
+
+(err/rt-test (exact-floor +nan.f))
+(err/rt-test (exact-floor -inf.f))
+(test -2 exact-floor -1.5f0)
+(test -1 exact-floor -0.5f0)
+(test 0 exact-floor 0.5f0)
+(test 1 exact-floor 1.5f0)
+(err/rt-test (exact-floor +inf.f))
+
+(err/rt-test (exact-floor +nan.0))
+(err/rt-test (exact-floor -inf.0))
+(test (inexact->exact -max.0) exact-floor -max.0)
+(test -2 exact-floor -1.5)
+(test -1 exact-floor -0.5)
+(test -1 exact-floor -min.0)
+(test 0 exact-floor +min.0)
+(test 0 exact-floor 0.5)
+(test 1 exact-floor 1.5)
+(test (inexact->exact +max.0) exact-floor +max.0)
+(err/rt-test (exact-floor +inf.0))
+
+;; =========================================================================
+;; exact-ceiling
+
+(test -1 exact-ceiling #e-1.5)
+(test 0 exact-ceiling #e-0.5)
+(test 1 exact-ceiling #e0.5)
+(test 2 exact-ceiling #e1.5)
+
+(err/rt-test (exact-ceiling +nan.f))
+(err/rt-test (exact-ceiling -inf.f))
+(test -1 exact-ceiling -1.5f0)
+(test 0 exact-ceiling -0.5f0)
+(test 1 exact-ceiling 0.5f0)
+(test 2 exact-ceiling 1.5f0)
+(err/rt-test (exact-ceiling +inf.f))
+
+(err/rt-test (exact-ceiling +nan.0))
+(err/rt-test (exact-ceiling -inf.0))
+(test (inexact->exact -max.0) exact-ceiling -max.0)
+(test -1 exact-ceiling -1.5)
+(test 0 exact-ceiling -0.5)
+(test 0 exact-ceiling -min.0)
+(test 1 exact-ceiling +min.0)
+(test 1 exact-ceiling 0.5)
+(test 2 exact-ceiling 1.5)
+(test (inexact->exact +max.0) exact-ceiling +max.0)
+(err/rt-test (exact-ceiling +inf.0))
+
+;; =========================================================================
+;; exact-truncate
+
+(test -1 exact-truncate #e-1.5)
+(test 0 exact-truncate #e-0.5)
+(test 0 exact-truncate #e0.5)
+(test 1 exact-truncate #e1.5)
+
+(err/rt-test (exact-truncate +nan.f))
+(err/rt-test (exact-truncate -inf.f))
+(test -1 exact-truncate -1.5f0)
+(test 0 exact-truncate -0.5f0)
+(test 0 exact-truncate 0.5f0)
+(test 1 exact-truncate 1.5f0)
+(err/rt-test (exact-truncate +inf.f))
+
+(err/rt-test (exact-truncate +nan.0))
+(err/rt-test (exact-truncate -inf.0))
+(test (inexact->exact -max.0) exact-truncate -max.0)
+(test -1 exact-truncate -1.5)
+(test 0 exact-truncate -0.5)
+(test 0 exact-truncate -min.0)
+(test 0 exact-truncate +min.0)
+(test 0 exact-truncate 0.5)
+(test 1 exact-truncate 1.5)
+(test (inexact->exact +max.0) exact-truncate +max.0)
+(err/rt-test (exact-truncate +inf.0))
+
+;; =========================================================================
+;; comparison with conversion to exact BEFORE integer conversion, in the
+;; range near where floating-point numbers become integer-only
+
+(define (test-integer-conversion convert exact-convert)
+  (for* ([y  '(-0.75 -0.5 -0.25 0.0 0.25 0.5 0.75)]
+         [e  (in-range 50 54)]
+         [i  (in-range -1 2)])
+    (define x (+ y (ordinal->flonum (+ i (flonum->ordinal (expt 2.0 e))))))
+    (test (convert (inexact->exact x)) exact-convert x)))
+
+(test-integer-conversion round exact-round)
+(test-integer-conversion floor exact-floor)
+(test-integer-conversion ceiling exact-ceiling)
+(test-integer-conversion truncate exact-truncate)
+
+;; =========================================================================
+;; order-of-magnitude
 
 (test 0 order-of-magnitude 1)
 (test 0 order-of-magnitude 9)
@@ -16,14 +436,3 @@
 (test 4 order-of-magnitude 10000)
 (test -2 order-of-magnitude 1/100)
 (test -3 order-of-magnitude 1/101)
-
-(test 25 sqr 5)
-(test 25 sqr -5)
-
-(test #t <= (abs (sin pi)) 0.0001)
-
-(test 1 sgn 1)
-(test -1 sgn -1)
-(test 0 sgn 0)
-(test 1 sgn 999)
-(test -1 sgn -999)
diff --git a/collects/tests/typed-racket/tr-random-testing.rkt b/collects/tests/typed-racket/tr-random-testing.rkt
index cd0a4431be..f124ab7800 100644
--- a/collects/tests/typed-racket/tr-random-testing.rkt
+++ b/collects/tests/typed-racket/tr-random-testing.rkt
@@ -3,7 +3,7 @@
 ;; Random testing of type preservation for floats.
 
 (require redex
-         racket/flonum racket/unsafe/ops
+         racket/flonum racket/unsafe/ops unstable/flonum
          racket/sandbox)
 
 (require (except-in typed-racket/utils/utils infer)
@@ -18,6 +18,8 @@
 (b:init) (n:init)
 (define-namespace-anchor anch)
 
+todo: exact numbers
+
 (define-language tr-arith ; to stay within floats, removed some numeric ops
   [n real]
   [E n
@@ -99,10 +101,33 @@
   (define subtype? (subtype type-after type-before))
   subtype?)
 
+(define (random-integer->random-float E)
+  (define r (random))
+  (cond 
+    ;; probability 1/4: noisify and convert to single flonum
+    [(r . < . 0.25)
+     (real->single-flonum (* (random) E))]
+    ;; probability 1/4: noisify and convert to double flonum
+    [(r . < . 0.5)
+     (real->double-flonum (* (random) E))]
+    ;; probability 1/4: convert to very small double flonum
+    [(r . < . 0.75)
+     (define x (ordinal->flonum E))
+     (cond [(= x 0.0)  (if ((random) . < . 0.5) 0.0 -0.0)]
+           [else  x])]
+    ;; probability 1/20: +nan.0
+    [(r . < . 0.8)
+     +nan.0]
+    ;; remaining probability: convert to very large double flonum
+    [else
+     (if ((random) . < . 0.5)
+         (flstep -inf.0 E)
+         (flstep +inf.0 (- E)))]))
+
 ;; Redex can't generate floats, so we convert ints to floats.
 (define (exp->float-exp E) ; numbers or symbols or lists
   (cond [(number? E)
-         (exact->inexact (* (random) E))] ; add noise
+         (random-integer->random-float E)]
         [(list? E)
          (map exp->float-exp E)]
         [else
diff --git a/collects/typed-racket/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt
index 2ad978571d..8ebffb8379 100644
--- a/collects/typed-racket/base-env/base-env-numeric.rkt
+++ b/collects/typed-racket/base-env/base-env-numeric.rkt
@@ -1808,7 +1808,8 @@
             (-NegRat . -> . -NegFixnum) ; -1
             (-NonPosRat . -> . -NonPosFixnum) ; 0 or -1
             (-Rat . -> . -Fixnum)
-            (-InexactReal . -> . -Flonum) ; single-flonums give a flonum result
+            (-Flonum . -> . -Flonum)
+            (-SingleFlonum . -> . -SingleFlonum)
             (-Real . -> . -Real))]
 
 [pi -PosFlonum]