Added fixnums to more type signatures.

2010-06-25 14:47:26 -04:00 · 2010-06-25 14:47:26 -04:00 · cee39c4a38
commit cee39c4a38
parent 06844073c7
5 changed files with 114 additions and 79 deletions
--- a/collects/typed-scheme/private/base-env-indexing-abs.rkt
+++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt
@ -30,31 +30,31 @@
   [string-copy! (-String index-type -String [index-type index-type] . ->opt . -Void)]

   [read-string (index-type [-Input-Port] . ->opt . (Un -String (-val eof)))]
-   [read-string! (-String [-Input-Port index-type index-type] . ->opt . (Un -Nat (-val eof)))]
+   [read-string! (-String [-Input-Port index-type index-type] . ->opt . (Un -NonnegativeFixnum (-val eof)))]
   [read-bytes (index-type [-Input-Port] . ->opt . (Un -Bytes (-val eof)))]

   [write-byte (cl-> [(index-type) -Void]
                     [(index-type -Output-Port) -Void])]
-   [write-string (cl-> [(-String) -Nat]
-                       [(-String -Output-Port) -Nat]
-                       [(-String -Output-Port index-type) -Nat]
-                       [(-String -Output-Port index-type index-type) -Nat])]
-   [write-bytes  (cl-> [(-Bytes) -Nat]
-                       [(-Bytes -Output-Port) -Nat]
-                       [(-Bytes -Output-Port index-type) -Nat]
-                       [(-Bytes -Output-Port index-type index-type) -Nat])]
-   [write-bytes-avail  (cl-> [(-Bytes) -Nat]
-                             [(-Bytes -Output-Port) -Nat]
-                             [(-Bytes -Output-Port index-type) -Nat]
-                             [(-Bytes -Output-Port index-type index-type) -Nat])]
-   [write-bytes-avail*  (cl-> [(-Bytes) (-opt -Nat)]
-                              [(-Bytes -Output-Port) (-opt -Nat)]
-                              [(-Bytes -Output-Port index-type) (-opt -Nat)]
-                              [(-Bytes -Output-Port index-type index-type) (-opt -Nat)])]
-   [write-bytes-avail/enable-break (cl-> [(-Bytes) -Nat]
-                                         [(-Bytes -Output-Port) -Nat]
-                                         [(-Bytes -Output-Port index-type) -Nat]
-                                         [(-Bytes -Output-Port index-type index-type) -Nat])]
+   [write-string (cl-> [(-String) -NonnegativeFixnum]
+                       [(-String -Output-Port) -NonnegativeFixnum]
+                       [(-String -Output-Port index-type) -NonnegativeFixnum]
+                       [(-String -Output-Port index-type index-type) -NonnegativeFixnum])]
+   [write-bytes  (cl-> [(-Bytes) -NonnegativeFixnum]
+                       [(-Bytes -Output-Port) -NonnegativeFixnum]
+                       [(-Bytes -Output-Port index-type) -NonnegativeFixnum]
+                       [(-Bytes -Output-Port index-type index-type) -NonnegativeFixnum])]
+   [write-bytes-avail  (cl-> [(-Bytes) -NonnegativeFixnum]
+                             [(-Bytes -Output-Port) -NonnegativeFixnum]
+                             [(-Bytes -Output-Port index-type) -NonnegativeFixnum]
+                             [(-Bytes -Output-Port index-type index-type) -NonnegativeFixnum])]
+   [write-bytes-avail*  (cl-> [(-Bytes) (-opt -NonnegativeFixnum)]
+                              [(-Bytes -Output-Port) (-opt -NonnegativeFixnum)]
+                              [(-Bytes -Output-Port index-type) (-opt -NonnegativeFixnum)]
+                              [(-Bytes -Output-Port index-type index-type) (-opt -NonnegativeFixnum)])]
+   [write-bytes-avail/enable-break (cl-> [(-Bytes) -NonnegativeFixnum]
+                                         [(-Bytes -Output-Port) -NonnegativeFixnum]
+                                         [(-Bytes -Output-Port index-type) -NonnegativeFixnum]
+                                         [(-Bytes -Output-Port index-type index-type) -NonnegativeFixnum])]


   
@ -109,7 +109,7 @@
          [-StrRx  (Un -String -Regexp -PRegexp)]
          [-BtsRx  (Un -Bytes  -Byte-Regexp -Byte-PRegexp)]
          [-InpBts (Un -Input-Port -Bytes)])
-      (->opt -Pattern (Un -String -InpBts) [N ?N ?outp] (optlist (-pair -Nat -Nat))))]
+      (->opt -Pattern (Un -String -InpBts) [N ?N ?outp] (optlist (-pair -NonnegativeFixnum -NonnegativeFixnum))))]
   [regexp-match-positions*
    (let ([?outp   (-opt -Output-Port)]
          [?N      (-opt index-type)]
@ -117,7 +117,7 @@
          [-StrRx  (Un -String -Regexp -PRegexp)]
          [-BtsRx  (Un -Bytes  -Byte-Regexp -Byte-PRegexp)]
          [-InpBts (Un -Input-Port -Bytes)])
-      (->opt -Pattern (Un -String -InpBts) [index-type ?N ?outp] (-lst (-pair -Nat -Nat))))]
+      (->opt -Pattern (Un -String -InpBts) [index-type ?N ?outp] (-lst (-pair -NonnegativeFixnum -NonnegativeFixnum))))]
   
   
   [take   (-poly (a) ((-lst a) index-type . -> . (-lst a)))]
@ -140,8 +140,8 @@
   [make-vector (-poly (a) (cl-> [(index-type) (-vec (Un -Nat a))]
                                 [(index-type a) (-vec a)]))]

-   [bytes-ref (-> -Bytes index-type -Nat)]
-   [unsafe-bytes-ref (-> -Bytes index-type -Nat)]
+   [bytes-ref (-> -Bytes index-type -NonnegativeFixnum)]
+   [unsafe-bytes-ref (-> -Bytes index-type -NonnegativeFixnum)]
   [bytes-set! (-> -Bytes index-type index-type -Void)]
   [unsafe-bytes-set! (-> -Bytes index-type index-type -Void)]
   [subbytes (cl-> [(-Bytes index-type) -Bytes] [(-Bytes index-type index-type) -Bytes])]
@ -153,10 +153,10 @@
   [string->bytes/utf-8 (-String [(Un (-val #f) index-type) index-type index-type] . ->opt . -Bytes)]
   [string->bytes/locale (-String [(Un (-val #f) index-type) index-type index-type] . ->opt . -Bytes)]
   [string->bytes/latin-1 (-String [(Un (-val #f) index-type) index-type index-type] . ->opt . -Bytes)]
-   [string-utf-8-length (-String [index-type index-type] . ->opt . -Nat)]
-   [bytes-utf-8-length (-Bytes [(Un (-val #f) -Char) index-type index-type] . ->opt . -Nat)]
+   [string-utf-8-length (-String [index-type index-type] . ->opt . -NonnegativeFixnum)]
+   [bytes-utf-8-length (-Bytes [(Un (-val #f) -Char) index-type index-type] . ->opt . -NonnegativeFixnum)]
   [bytes-utf-8-ref (-Bytes [index-type (Un (-val #f) -Char) index-type index-type] . ->opt . -Char)]
-   [bytes-utf-8-index (-Bytes [index-type (Un (-val #f) -Char) index-type index-type] . ->opt . -Nat)]
+   [bytes-utf-8-index (-Bytes [index-type (Un (-val #f) -Char) index-type index-type] . ->opt . -NonnegativeFixnum)]

   
   [peek-char
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@ -20,7 +20,14 @@
    (lambda (t [r t])
      (t t . -> . r)))
  (define-for-syntax rounder 
-    (cl->* (-> -ExactRational -Integer) (-> -Flonum -Flonum) (-> -Real -Real)))
+    (cl->* (-> -PositiveFixnum -PositiveFixnum)
+           (-> -NonnegativeFixnum -NonnegativeFixnum)
+           (-> -Fixnum -Fixnum)
+           (-> -Pos -Pos)
+           (-> -Nat -Nat)
+           (-> -ExactRational -Integer)
+           (-> -Flonum -Flonum)
+           (-> -Real -Real)))
  
  (define-for-syntax (unop t) (-> t t))
  
@ -33,9 +40,11 @@
  (define-for-syntax nat-op (binop -Nat))
  
  (define-for-syntax fx-comp (binop -Integer B))
-  (define-for-syntax fx-op (cl->* nat-op int-op))
-  (define-for-syntax fx-intop int-op)
-  (define-for-syntax fx-unop (unop -Integer))
+  (define-for-syntax fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum)
+                                  (-Nat -Nat . -> . -NonnegativeFixnum)
+                                  (-Integer -Integer . -> . -Fixnum)))
+  (define-for-syntax fx-intop (-Integer -Integer . -> . -Fixnum))
+  (define-for-syntax fx-unop (-Integer . -> . -Fixnum))

  (define-for-syntax real-comp (->* (list R R) R B))
  )
@ -62,7 +71,9 @@
 [odd? (-> -Integer B)]
 [even? (-> -Integer B)]

-[modulo (cl->* (-Nat -Nat . -> . -Nat)
+[modulo (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . -NonnegativeFixnum)
+               (-Fixnum -Fixnum . -> . -Fixnum)
+               (-Nat -Nat . -> . -Nat)
               (-Integer -Integer . -> . -Integer))]

 [=  (->* (list N N) N B)]
@ -107,8 +118,16 @@
                  (list (->* (list -Real) -Real -Real))
                  (list (->* (list N) N N))))]

-[max (apply cl->* (->* (list -Pos) -Integer -Pos) (->* (list -Nat) -Integer -Nat) (for/list ([t all-num-types]) (->* (list t) t t)))]
-[min (apply cl->* (for/list ([t all-num-types]) (->* (list t) t t)))]
+[max (apply cl->*
+            (->* (list -PositiveFixnum) -Fixnum -PositiveFixnum)
+            (->* (list -NonnegativeFixnum) -Fixnum -NonnegativeFixnum)
+            (->* (list -Fixnum) -Fixnum -Fixnum)
+            (->* (list -Pos) -Integer -Pos)
+            (->* (list -Nat) -Integer -Nat)
+            (for/list ([t all-num-types]) (->* (list t) t t)))]
+[min (apply cl->*
+            (->* (list -Fixnum) -Fixnum -Fixnum)
+            (for/list ([t all-num-types]) (->* (list t) t t)))]


 [add1 (cl->* (-> -Pos -Pos)
@ -126,28 +145,42 @@
             (-> -Real -Real)
             (-> N N))]

-[quotient (cl->* (-Nat -Nat . -> . -Nat)
+[quotient (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . -NonnegativeFixnum)
+                 (-Fixnum -Fixnum . -> . -Fixnum)
+                 (-Nat -Nat . -> . -Nat)
                 (-Integer -Integer . -> . -Integer))]
-[remainder (cl->* (-Nat -Nat . -> . -Nat)
+[remainder (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . -NonnegativeFixnum)
+                  (-Fixnum -Fixnum . -> . -Fixnum)
+                  (-Nat -Nat . -> . -Nat)
                  (-Integer -Integer . -> . -Integer))]
-[quotient/remainder (cl->* (-Nat -Nat . -> . (-values (list -Nat -Nat)))
+[quotient/remainder (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . (-values (list -NonnegativeFixnum -NonnegativeFixnum)))
+                           (-Fixnum -Fixnum . -> . (-values (list -Fixnum -Fixnum)))
+                           (-Nat -Nat . -> . (-values (list -Nat -Nat)))
                           (-Integer -Integer . -> . (-values (list -Integer -Integer))))]

-[arithmetic-shift (cl->* (-Nat -Nat . -> . -Nat)
+[arithmetic-shift (cl->* (-Fixnum (Un -NegativeFixnum (-val 0)) . -> . -Fixnum)
+                         (-Nat -Nat . -> . -Nat)
                         (-Integer -Integer . -> . -Integer))]
-[bitwise-and (cl->* (null -Nat . ->* . -Nat)
+[bitwise-and (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)
+                    (null -Fixnum . ->* . -Fixnum)
+                    (null -Nat . ->* . -Nat)
                    (null -Integer . ->* . -Integer))]
-[bitwise-ior (cl->* (null -Nat . ->* . -Nat)
+[bitwise-ior (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)
+                    (null -Fixnum . ->* . -Fixnum)
+                    (null -Nat . ->* . -Nat)
                    (null -Integer . ->* . -Integer))]
-[bitwise-not (cl->* (null -Nat . ->* . -Nat)
+[bitwise-not (cl->* (null -Fixnum . ->* . -Fixnum)
                    (null -Integer . ->* . -Integer))]
-[bitwise-xor (cl->* (null -Nat . ->* . -Nat)
+[bitwise-xor (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)
+                    (null -Fixnum . ->* . -Fixnum)
+                    (null -Nat . ->* . -Nat)
                    (null -Integer . ->* . -Integer))]
 [bitwise-bit-set? (-> -Integer -Integer B)]
 [bitwise-bit-field (-> -Integer -Integer -Integer -Integer)]
-[integer-length (-> -Integer -Nat)]
+[integer-length (-> -Integer -NonnegativeFixnum)]

-[abs (cl->* (-Integer . -> . -Nat)
+[abs (cl->* (-Fixnum . -> . -NonnegativeFixnum)
+            (-Integer . -> . -Nat)
            (-Real . -> . -Real))]

 ;; exactness
@ -189,7 +222,7 @@
 [acos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))]
 [asin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N))]
 [atan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (N . -> . N) (-Real -Real . -> . N))]
-[gcd  (null -Integer . ->* . -Integer)]
+[gcd  (cl->* (null -Fixnum . ->* . -Fixnum) (null -Integer . ->* . -Integer))]
 [lcm  (null -Integer . ->* . -Integer)]

 ;; scheme/math
@ -243,14 +276,14 @@
 [unsafe-fxquotient fx-intop]
 [unsafe-fxremainder fx-intop]
 [unsafe-fxmodulo fx-intop]
-[unsafe-fxabs (-Integer . -> . -Nat)]
+[unsafe-fxabs (-Integer . -> . (Un -PositiveFixnum (-val 0)))]

-[unsafe-fxand fx-intop]
-[unsafe-fxior fx-intop]
-[unsafe-fxxor fx-intop]
+[unsafe-fxand fx-op]
+[unsafe-fxior fx-op]
+[unsafe-fxxor fx-op]
 [unsafe-fxnot fx-unop]
 [unsafe-fxlshift fx-intop]
-[unsafe-fxrshift fx-intop]
+[unsafe-fxrshift (cl->* (-> -NonnegativeFixnum -NonnegativeFixnum -NonnegativeFixnum) fx-intop)]

 [unsafe-fx= fx-comp]
 [unsafe-fx< fx-comp]
@ -268,14 +301,14 @@
 [fxquotient fx-intop]
 [fxremainder fx-intop]
 [fxmodulo fx-intop]
-[fxabs (-Integer . -> . -Nat)]
+[fxabs (-Integer . -> . (Un -PositiveFixnum (-val 0)))]

-[fxand fx-intop]
-[fxior fx-intop]
-[fxxor fx-intop]
+[fxand fx-op]
+[fxior fx-op]
+[fxxor fx-op]
 [fxnot fx-unop]
 [fxlshift fx-intop]
-[fxrshift fx-intop]
+[fxrshift (cl->* (-> -NonnegativeFixnum -NonnegativeFixnum -NonnegativeFixnum) fx-intop)]

 [fx= fx-comp]
 [fx< fx-comp]
@ -320,12 +353,12 @@
 [flvector (->* (list) -Flonum -FlVector)]
 [make-flvector (cl->* (-> -Integer -FlVector)
                      (-> -Integer -Flonum -FlVector))]
-[flvector-length (-> -FlVector -Nat)]
+[flvector-length (-> -FlVector -NonnegativeFixnum)]
 [flvector-ref (-> -FlVector -Integer -Flonum)]
 [flvector-set! (-> -FlVector -Integer -Flonum -Void)]

 ;; unsafe flvector ops

-[unsafe-flvector-length (-> -FlVector -Nat)]
+[unsafe-flvector-length (-> -FlVector -NonnegativeFixnum)]
 [unsafe-flvector-ref (-> -FlVector -Integer -Flonum)]
 [unsafe-flvector-set! (-> -FlVector -Integer -Flonum -Void)]
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@ -217,8 +217,8 @@

 [string? (make-pred-ty -String)]
 [string (->* '() -Char -String)]
-[string-length (-String . -> . -PositiveFixnum)]
-[unsafe-string-length (-String . -> . -PositiveFixnum)]
+[string-length (-String . -> . -NonnegativeFixnum)]
+[unsafe-string-length (-String . -> . -NonnegativeFixnum)]

 [symbol? (make-pred-ty Sym)]
 [keyword? (make-pred-ty -Keyword)]
@ -301,7 +301,7 @@

 [reverse (-poly (a) (-> (-lst a) (-lst a)))]
 [append (-poly (a) (->* (list) (-lst a) (-lst a)))]
-[length (-poly (a) (-> (-lst a) -PositiveFixnum))]
+[length (-poly (a) (-> (-lst a) -NonnegativeFixnum))]
 [memq (-poly (a) (-> a (-lst a) (-opt (-lst a))))]
 [memv (-poly (a) (-> a (-lst a) (-opt (-lst a))))]
 [memf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt (-lst a))))]
@ -354,8 +354,8 @@
 [char-downcase (-> -Char -Char)]
 [char-titlecase (-> -Char -Char)]
 [char-foldcase (-> -Char -Char)]
-[char->integer (-> -Char -PositiveFixnum)]
-[integer->char (-> -Nat -Char)]
+[char->integer (-> -Char -NonnegativeFixnum)]
+[integer->char (-> -Integer -Char)]
 [char-utf-8-length (-> -Char (apply Un (map -val '(1 2 3 4 5 6))))]

 [string-normalize-nfd (-> -String -String)]
@ -481,16 +481,16 @@

 [vector->list (-poly (a) (-> (-vec a) (-lst a)))]
 [list->vector (-poly (a) (-> (-lst a) (-vec a)))]
-[vector-length ((make-VectorTop) . -> . -PositiveFixnum)]
+[vector-length ((make-VectorTop) . -> . -NonnegativeFixnum)]
 [vector (-poly (a) (->* (list) a (-vec a)))]
 [vector-immutable (-poly (a) (->* (list) a (-vec a)))]
 [vector->immutable-vector (-poly (a) (-> (-vec a) (-vec a)))]
 [vector-fill! (-poly (a) (-> (-vec a) a -Void))]
 [vector-argmax (-poly (a) (-> (-> a -Real) (-vec a) a))]
 [vector-argmin (-poly (a) (-> (-> a -Real) (-vec a) a))]
-[vector-memq (-poly (a) (-> a (-vec a) (-opt -PositiveFixnum)))]
-[vector-memv (-poly (a) (-> a (-vec a) (-opt -PositiveFixnum)))]
-[vector-member (-poly (a) (a (-vec a) . -> . (-opt -PositiveFixnum)))]
+[vector-memq (-poly (a) (-> a (-vec a) (-opt -NonnegativeFixnum)))]
+[vector-memv (-poly (a) (-> a (-vec a) (-opt -NonnegativeFixnum)))]
+[vector-member (-poly (a) (a (-vec a) . -> . (-opt -NonnegativeFixnum)))]
 ;; [vector->values no good type here]


@ -548,7 +548,7 @@
 [hash-remove! (-poly (a b) ((-HT a b) a . -> . -Void))]
 [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
 [hash-for-each (-poly (a b c) (-> (-HT a b) (-> a b c) -Void))]
-[hash-count (-poly (a b) (-> (-HT a b) -PositiveFixnum))]
+[hash-count (-poly (a b) (-> (-HT a b) -NonnegativeFixnum))]
 [hash-copy (-poly (a b) (-> (-HT a b) (-HT a b)))]
 [eq-hash-code (-poly (a) (-> a -Integer))]
 [eqv-hash-code (-poly (a) (-> a -Integer))]
@ -568,12 +568,12 @@
 [make-bytes (cl-> [(-Integer -Integer) -Bytes]
                  [(-Integer) -Bytes])]
 [bytes->immutable-bytes (-> -Bytes -Bytes)]
-[byte? (make-pred-ty -Nat)]
+[byte? (make-pred-ty -NonnegativeFixnum)]
 [bytes-append (->* (list) -Bytes -Bytes)]
-[bytes-length (-> -Bytes -PositiveFixnum)]
-[unsafe-bytes-length (-> -Bytes -PositiveFixnum)]
+[bytes-length (-> -Bytes -NonnegativeFixnum)]
+[unsafe-bytes-length (-> -Bytes -NonnegativeFixnum)]
 [bytes-copy (-> -Bytes -Bytes)]
-[bytes->list (-> -Bytes (-lst -Nat))]
+[bytes->list (-> -Bytes (-lst -NonnegativeFixnum))]
 [list->bytes (-> (-lst -Integer) -Bytes)]
 [bytes<? (->* (list -Bytes) -Bytes B)]
 [bytes>? (->* (list -Bytes) -Bytes B)]
@ -671,7 +671,7 @@

 [list->string ((-lst -Char) . -> . -String)]
 [string->list (-String . -> . (-lst -Char))]
-[build-string (-Nat (-Nat . -> . -Char) . -> . -String)]
+[build-string (-Nat (-Integer . -> . -Char) . -> . -String)]

 [sort (-poly (a b) (cl->* ((-lst a) (a a . -> . B)
                          #:cache-keys? B #f
@ -711,7 +711,7 @@
                    (-lst a))
                   ((-lst b) b) 
                   . ->... . 
-                   -PositiveFixnum))]
+                   -NonnegativeFixnum))]
 [filter-map (-polydots (c a b)
                       ((list
                         ((list a) (b b) . ->... . (-opt c))
@ -744,7 +744,7 @@
 [tcp-accept-ready? (-TCP-Listener . -> . B )]
 [tcp-addresses (cl->*
 		(-Port [(-val #f)] . ->opt . (-values (list -String -String)))
-		(-Port (-val #t) . -> . (-values (list -String -Nat -String -Nat))))]
+		(-Port (-val #t) . -> . (-values (list -String -NonnegativeFixnum -String -NonnegativeFixnum))))]
 [tcp-close (-TCP-Listener . -> . -Void )]
 [tcp-connect (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))]
 [tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))]
@ -808,8 +808,8 @@

 ;; unsafe

-[unsafe-vector-length (-poly (a) ((-vec a) . -> . -PositiveFixnum))]
-[unsafe-vector*-length (-poly (a) ((-vec a) . -> . -PositiveFixnum))]
+[unsafe-vector-length (-poly (a) ((-vec a) . -> . -NonnegativeFixnum))]
+[unsafe-vector*-length (-poly (a) ((-vec a) . -> . -NonnegativeFixnum))]
 [unsafe-car (-poly (a b) 
                   (cl->*
                    (->acc (list (-pair a b)) a (list -car))
@ -827,7 +827,7 @@
                           (-vec a))
                          ((-vec b) b)
                          . ->... . 
-                          -PositiveFixnum))]
+                          -NonnegativeFixnum))]
 [vector-filter (-poly (a b) (cl->*
                             ((make-pred-ty (list a) Univ b)
                              (-vec a)
@ -904,6 +904,6 @@
                         (-> (-mlst a) (-mlst a) -Void)))]
 [mpair? (make-pred-ty (make-MPairTop))]
 [mlist (-poly (a) (->* (list) a (-mlst a)))]
-[mlength (-poly (a) (-> (-mlst a) -PositiveFixnum))]
+[mlength (-poly (a) (-> (-mlst a) -NonnegativeFixnum))]
 [mreverse! (-poly (a) (-> (-mlst a) (-mlst a)))]
 [mappend (-poly (a) (->* (list) (-mlst a) (-mlst a)))]
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@ -9,6 +9,7 @@
 [Exact-Positive-Integer -ExactPositiveInteger]
 [Exact-Nonnegative-Integer -ExactNonnegativeInteger]
 [Positive-Fixnum -PositiveFixnum]
+[Nonnegative-Fixnum -NonnegativeFixnum]
 [Fixnum -Fixnum]
 [Natural -ExactNonnegativeInteger]
 [Zero (-val 0)]
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@ -166,6 +166,7 @@
 (define -Zero (-val 0))
 (define -Real (*Un -Flonum -ExactRational))
 (define -Fixnum (*Un -PositiveFixnum -NegativeFixnum -Zero))
+(define -NonnegativeFixnum (*Un -PositiveFixnum -Zero))
 (define -ExactNonnegativeInteger (*Un -ExactPositiveInteger -Zero))
 (define -Nat -ExactNonnegativeInteger)