From b2d591e70b25fe5afa02b0e93c1c59f56598e1c5 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 7 Mar 2011 17:20:44 -0500
Subject: [PATCH] Provide the index? predicate.

original commit: 17afa91c095d9df8f91820dcb8268df34f9f0165
---
 collects/typed-scheme/private/base-env-numeric.rkt | 4 +++-
 collects/typed-scheme/private/prims.rkt            | 4 +++-
 collects/typed-scheme/types/numeric-predicates.rkt | 2 +-
 collects/typed-scheme/types/numeric-tower.rkt      | 2 +-
 4 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index bb430f67..eb17a8ee 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -3,7 +3,8 @@
 (begin
   (require
    racket/list
-   (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base)
+   (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base
+                 (only-in "../types/numeric-predicates.rkt" index?))
    (only-in (types abbrev numeric-tower) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-PosInt -Pos]))
 
   ;; TODO having definitions only at the top is really inconvenient.
@@ -598,6 +599,7 @@
 [exact? (asym-pred N B (-FS -top (-not-filter -Rat 0)))]
 [inexact? (asym-pred N B  (-FS -top (-not-filter (Un -InexactReal -FloatComplex) 0)))]
 [fixnum? (make-pred-ty -Fixnum)]
+[index? (make-pred-ty -Index)]
 [positive? (cl->* (-> -Byte B : (-FS (-filter -PosByte 0) (-filter -Zero 0)))
                   (-> -Index B : (-FS (-filter -PosIndex 0) (-filter -Zero 0)))
                   (-> -Fixnum B : (-FS (-filter -PosFixnum 0) (-filter -NonPosFixnum 0)))
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 44c3118c..f5215b2d 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -48,7 +48,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
           "../utils/tc-utils.rkt"	  
           "../env/type-name-env.rkt"
           "type-contract.rkt"
-          "for-clauses.rkt"))
+          "for-clauses.rkt")
+         "../types/numeric-predicates.rkt")
+(provide index?) ; useful for assert, and racket doesn't have it
 
 (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t))
 
diff --git a/collects/typed-scheme/types/numeric-predicates.rkt b/collects/typed-scheme/types/numeric-predicates.rkt
index d6463a9b..c6accf1d 100644
--- a/collects/typed-scheme/types/numeric-predicates.rkt
+++ b/collects/typed-scheme/types/numeric-predicates.rkt
@@ -9,6 +9,6 @@
 ;; we assume indexes are 2 bits shorter than fixnums
 ;; We're generating a reference to fixnum? rather than calling it, so
 ;; we're safe from fixnum size issues on different platforms.
-(define (index? x) (and (fixnum? x) (fixnum? (* x 4))))
+(define (index? x) (and (fixnum? x) (>= x 0) (fixnum? (* x 4))))
 
 (define exact-rational? (conjoin rational? exact?))
diff --git a/collects/typed-scheme/types/numeric-tower.rkt b/collects/typed-scheme/types/numeric-tower.rkt
index bf87e039..9d10a7dc 100644
--- a/collects/typed-scheme/types/numeric-tower.rkt
+++ b/collects/typed-scheme/types/numeric-tower.rkt
@@ -42,7 +42,7 @@
 (define (portable-index? n)
   (and (exact-integer? n)
        (< n (expt 2 28))
-       (>= n (- (expt 2 28)))))
+       (>= n 0)))
 
 ;; Singletons
 (define -Zero (-val 0)) ; exact