From a431e55952feb291de4669a37b39bdce22f6af64 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 6 Jan 2010 23:21:31 +0000
Subject: [PATCH] fix lots of numeric types

svn: r17520

original commit: 8b7fb016923da57df016ade78089468a902483d2
---
 .../typed-scheme/private/base-env-numeric.ss  | 57 ++++++++++++-------
 1 file changed, 37 insertions(+), 20 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.ss b/collects/typed-scheme/private/base-env-numeric.ss
index f0c05718..f551137d 100644
--- a/collects/typed-scheme/private/base-env-numeric.ss
+++ b/collects/typed-scheme/private/base-env-numeric.ss
@@ -3,7 +3,7 @@
 (begin
   (require
    scheme/tcp
-   scheme
+   scheme scheme/flonum
    scheme/unsafe/ops
    (only-in rnrs/lists-6 fold-left)
    '#%paramz
@@ -26,14 +26,19 @@
 ;; numeric predicates
 [zero? (make-pred-ty (list N) B -Zero)]
 [number? (make-pred-ty N)]
-[integer? (Univ . -> . B : (-LFS (list (-filter -Real)) (list (-not-filter -Integer))))]
+[integer? (Univ . -> . B : (-LFS (list (-filter (Un -Integer -Flonum))) (list (-not-filter -Integer))))]
 [exact-integer? (make-pred-ty -Integer)]
 [real? (make-pred-ty -Real)]
+[inexact-real? (make-pred-ty -Flonum)]
 [complex? (make-pred-ty N)]
 [rational? (make-pred-ty -Real)]
-
+[exact? (N . -> . B : (-LFS (list) (list (-not-filter -ExactRational))))]
+[inexact? (N . -> . B : (-LFS (list) (list (-not-filter -Flonum))))]
+[fixnum? (Univ . -> . B : (-LFS (list (-filter -Integer)) null))]
 [positive? (-> -Real B)]
 [negative? (-> -Real B)]
+[exact-positive-integer? (make-pred-ty -Pos)]
+[exact-nonnegative-integer? (make-pred-ty -Nat)]
 
 [odd? (-> -Integer B)]
 [even? (-> -Integer B)]
@@ -84,8 +89,6 @@
  (make-Function (list (make-arr (list -Integer -Integer) (-values (list -Integer -Integer)))))]
 
 ;; exactness
-[exact? (N . -> . B)]
-[inexact? (N . -> . B)]
 [exact->inexact (cl->* 
                  (-Real . -> . -Flonum)
                  (N . -> . N))]
@@ -93,18 +96,18 @@
                  (-Real . -> . -ExactRational)
                  (N . -> . N))]
 
-[floor    (-> N N)]
-[ceiling  (-> N N)]
-[truncate (-> N N)]
-[make-rectangular (N N . -> . N)]
-[make-polar (N N . -> . N)]
-[real-part (N . -> . N)]
-[imag-part (N . -> . N)]
-[magnitude (N . -> . N)]
-[angle     (N . -> . N)]
-[numerator   (N . -> . -Integer)]
-[denominator (N . -> . -Integer)]
-[rationalize (N N . -> . N)]
+[floor    (-> -Real -Real)]
+[ceiling  (-> -Real -Real)]
+[truncate (-> -Real -Real)]
+[make-rectangular (-Real -Real . -> . N)]
+[make-polar (-Real -Real . -> . N)]
+[real-part (N . -> . -Real)]
+[imag-part (N . -> . -Real)]
+[magnitude (N . -> . -Real)]
+[angle     (N . -> . -Real)]
+[numerator   (-Real . -> . -Integer)]
+[denominator (-Real . -> . -Integer)]
+[rationalize (-Real -Real . -> . N)]
 [expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))]
 [sqrt (cl->*
        (-Nat . -> . -Real)
@@ -122,12 +125,12 @@
 [gcd  (null -Integer . ->* . -Integer)]
 [lcm  (null -Integer . ->* . -Integer)]
 
-[round (N . -> . -Integer)]
+[round (-Real . -> . -Real)]
 
 ;; scheme/math
 
 [sgn (-Real . -> . -Real)]
-[pi N]
+[pi -Flonum]
 [sqr (cl->* (-> -Pos -Pos)
             (-> -Nat -Nat)                          
             (-> -Integer -Integer)
@@ -140,9 +143,10 @@
 [sinh (N . -> . N)]
 [cosh (N . -> . N)]
 [tanh (N . -> . N)]
-;; unsafe numeric ops
 
+;; unsafe numeric ops
 [unsafe-flabs fl-unop]
+[unsafe-flsqrt fl-unop]
 
 [unsafe-fl+ fl-op]
 [unsafe-fl- fl-op]
@@ -154,3 +158,16 @@
 [unsafe-fl>= fl-comp]
 [unsafe-fl> fl-comp]
 [unsafe-fl< fl-comp]
+
+;; safe flonum ops
+[flabs fl-unop]
+[flsqrt fl-unop]
+[fl+ fl-op]
+[fl- fl-op]
+[fl* fl-op]
+[fl/ fl-op]
+[fl= fl-comp]
+[fl<= fl-comp]
+[fl>= fl-comp]
+[fl> fl-comp]
+[fl< fl-comp]