From 2229173b82b295a74269a11b9ff360a840f15b8f Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sat, 29 May 2010 11:29:39 -0400
Subject: [PATCH] Changed the types of some numerical operations to be closed
 on naturals.

---
 .../typed-scheme/unit-tests/typecheck-tests.rkt    |  2 +-
 .../typed-scheme/private/base-env-indexing-abs.rkt |  2 +-
 collects/typed-scheme/private/base-env-numeric.rkt | 14 +++++++++-----
 3 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index f231b28973..74608a2526 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -556,7 +556,7 @@
                            [(a*) (quotient 5 12)]
                            [(b*) (remainder 5 12)])
                 (+ a b a* b*))
-              -Integer]
+              -Nat]
         
         [tc-e (raise-type-error 'foo "bar" 5) (t:Un)]
         [tc-e (raise-type-error 'foo "bar" 7 (list 5)) (t:Un)]
diff --git a/collects/typed-scheme/private/base-env-indexing-abs.rkt b/collects/typed-scheme/private/base-env-indexing-abs.rkt
index 3fae1971a0..c27598b695 100644
--- a/collects/typed-scheme/private/base-env-indexing-abs.rkt
+++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt
@@ -104,7 +104,7 @@
    [build-vector (-poly (a) (-Nat (-Nat . -> . a) . -> . (-vec a)))]
    [vector-set! (-poly (a) (-> (-vec a) -Nat a -Void))]
    [vector-copy! (-poly (a) ((-vec a) -Nat (-vec a) [-Nat -Nat] . ->opt . -Void))]
-   [make-vector (-poly (a) (cl-> [(-Nat) (-vec -Integer)]
+   [make-vector (-poly (a) (cl-> [(-Nat) (-vec -Nat)]
                                  [(-Nat a) (-vec a)]))]
    
    [peek-char
diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 61becebd5e..479e21bca3 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -101,10 +101,12 @@
              (-> -Real -Real)
              (-> N N))]
 
-[quotient (-Integer -Integer . -> . -Integer)]
-[remainder (-Integer -Integer . -> . -Integer)]
-[quotient/remainder 
- (make-Function (list (make-arr (list -Integer -Integer) (-values (list -Integer -Integer)))))]
+[quotient (cl->* (-Nat -Nat . -> . -Nat)
+                 (-Integer -Integer . -> . -Integer))]
+[remainder (cl->* (-Nat -Nat . -> . -Nat)
+                  (-Integer -Integer . -> . -Integer))]
+[quotient/remainder (cl->* (-Nat -Nat . -> . (-values (list -Nat -Nat)))
+                           (-Integer -Integer . -> . (-values (list -Integer -Integer))))]
 
 ;; exactness
 [exact->inexact (cl->* 
@@ -127,7 +129,9 @@
 [numerator   (-Real . -> . -Real)]
 [denominator (-Real . -> . -Real)]
 [rationalize (-Real -Real . -> . N)]
-[expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))]
+[expt (cl->* (-Nat -Nat . -> . -Nat)
+             (-Integer -Integer . -> . -Integer)
+             (N N . -> . N))]
 [sqrt (cl->*
        (-Nat . -> . -Real)
        (N . -> . N))]