From ee142047f801da2cac93b681c368921e8f2a2541 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 20 Jun 2012 17:08:16 -0400 Subject: [PATCH] Add type for range, and extend in-range's. --- .../unit-tests/typecheck-tests.rkt | 4 +++ .../base-env/base-env-indexing-abs.rkt | 23 +++++++++++++++ .../base-env/base-special-env.rkt | 28 ++++++++++++++----- 3 files changed, 48 insertions(+), 7 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 788252f080..4bd95698da 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -207,6 +207,10 @@ [tc-e/t #(2 3 #t) (make-HeterogenousVector (list -Integer -Integer -Boolean))] [tc-e (vector 2 "3" #t) (make-HeterogenousVector (list -Integer -String -Boolean))] [tc-e (vector-immutable 2 "3" #t) (make-HeterogenousVector (list -Integer -String -Boolean))] + [tc-e (range 4) (-lst -Byte)] + [tc-e (range 2 4 1) (-lst -PosByte)] + [tc-e (range 0 4 1) (-lst -Byte)] + [tc-e (range 0.0 4/2 0.5) (-lst -Flonum)] [tc-e/t '(#t #f) (-lst* (-val #t) (-val #f))] [tc-e/t (plambda: (a) ([l : (Listof a)]) (car l)) (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))] diff --git a/collects/typed-racket/base-env/base-env-indexing-abs.rkt b/collects/typed-racket/base-env/base-env-indexing-abs.rkt index 1de569c9b1..79a9da5ca6 100644 --- a/collects/typed-racket/base-env/base-env-indexing-abs.rkt +++ b/collects/typed-racket/base-env/base-env-indexing-abs.rkt @@ -215,6 +215,29 @@ + [range (cl->* (-> (Un -Zero -NegInt) (-val '())) + (-> -One (-pair -One (-val '()))) + (-> -Byte (-lst -Byte)) + (-> -Index (-lst -Index)) + (-> -Fixnum (-lst -Fixnum)) + (-> -Real (-lst -Int)) + (->opt -PosInt -Byte [-Int] (-lst -PosByte)) + (->opt -Nat -Byte [-Int] (-lst -Byte)) + (->opt -PosInt -Index [-Int] (-lst -PosIndex)) + (->opt -Nat -Index [-Int] (-lst -Index)) + (->opt -Nat -NonNegFixnum [-Int] (-lst -NonNegFixnum)) + (->opt -PosInt -Fixnum [-Nat] (-lst -PosFixnum)) + (->opt -Nat -Fixnum [-Nat] (-lst -NonNegFixnum)) + (->opt -Nat -Nat [-Int] (-lst -Nat)) + (->opt -PosInt -Int [-Nat] (-lst -PosInt)) + (->opt -Nat -Int [-Nat] (-lst -Nat)) + ;; could add cases that guarantee lists of negatives, etc. + (->opt -Int -Real [-Int] (-lst -Int)) + (->opt -Rat -Real [-Rat] (-lst -Rat)) + (->opt -Flonum -Real [-Flonum] (-lst -Flonum)) + (->opt -SingleFlonum -Real [-SingleFlonum] (-lst -SingleFlonum)) + (->opt -InexactReal -Real [-InexactReal] (-lst -InexactReal)) + (->opt -Real -Real [-Real] (-lst -Real)))] [take (-poly (a) ((-lst a) index-type . -> . (-lst a)))] [drop (-poly (a) ((-lst a) index-type . -> . (-lst a)))] [take-right (-poly (a) ((-lst a) index-type . -> . (-lst a)))] diff --git a/collects/typed-racket/base-env/base-special-env.rkt b/collects/typed-racket/base-env/base-special-env.rkt index 67962e5c23..51f0a310c1 100644 --- a/collects/typed-racket/base-env/base-special-env.rkt +++ b/collects/typed-racket/base-env/base-special-env.rkt @@ -70,13 +70,27 @@ (-> Univ (-seq a b) (seq-vals (list a b))))))] ;; in-range [(make-template-identifier 'in-range 'racket/private/for) - (cl->* (-Byte [-Byte -Byte] . ->opt . (-seq -Byte)) - (-PosFixnum -Fixnum [-Nat] . ->opt . (-seq -PosFixnum)) - (-NonNegFixnum [-Fixnum -Nat] . ->opt . (-seq -NonNegFixnum)) - (-Fixnum [-Fixnum -Int] . ->opt . (-seq -Fixnum)) - (-PosInt -Int [-Nat] . ->opt . (-seq -PosInt)) - (-Nat [-Int -Nat] . ->opt . (-seq -Nat)) - (-Int [-Int -Int] . ->opt . (-seq -Int)))] + (cl->* (-> -Byte (-seq -Byte)) + (-> -Index (-seq -Index)) + (-> -Fixnum (-seq -Fixnum)) + (-> -Real (-seq -Int)) + (->opt -PosInt -Byte [-Int] (-seq -PosByte)) + (->opt -Nat -Byte [-Int] (-seq -Byte)) + (->opt -PosInt -Index [-Int] (-seq -PosIndex)) + (->opt -Nat -Index [-Int] (-seq -Index)) + (->opt -Nat -NonNegFixnum [-Int] (-seq -NonNegFixnum)) + (->opt -PosInt -Fixnum [-Nat] (-seq -PosFixnum)) + (->opt -Nat -Fixnum [-Nat] (-seq -NonNegFixnum)) + (->opt -Nat -Nat [-Int] (-seq -Nat)) + (->opt -PosInt -Int [-Nat] (-seq -PosInt)) + (->opt -Nat -Int [-Nat] (-seq -Nat)) + ;; could add cases that guarantee lists of negatives, etc. + (->opt -Int -Real [-Int] (-seq -Int)) + (->opt -Rat -Real [-Rat] (-seq -Rat)) + (->opt -Flonum -Real [-Flonum] (-seq -Flonum)) + (->opt -SingleFlonum -Real [-SingleFlonum] (-seq -SingleFlonum)) + (->opt -InexactReal -Real [-InexactReal] (-seq -InexactReal)) + (->opt -Real -Real [-Real] (-seq -Real)))] ;; in-naturals [(make-template-identifier 'in-naturals 'racket/private/for) (cl->* (-> -PosInt (-seq -PosInt))