Refine types of integer-bytes->integer' and arithmetic-shift'.

original commit: 0a3a71fbbc4fece033d57b41e36f1deb591c1e8d
This commit is contained in:
Vincent St-Amour 2011-11-15 15:29:37 -05:00
parent 8e83505012
commit 96c0eb804c
3 changed files with 16 additions and 4 deletions

View File

@ -266,6 +266,9 @@
(when (boolean? x) #t))
-Void]
[tc-e (integer-bytes->integer '#"abcd" #t) -Nat]
[tc-e (integer-bytes->integer '#"abcd" #f) -Int]
[tc-e/t (let: ([x : Any 3])
(if (list? x)
(begin (car x) 1)

View File

@ -303,7 +303,14 @@
[bytes-utf-8-index (-Bytes [index-type (Un (-val #f) -Char) index-type index-type] . ->opt . -Index)]
[integer->integer-bytes (-Integer index-type Univ [Univ -Bytes index-type] . ->opt . -Bytes)]
[integer-bytes->integer (-Bytes Univ [Univ index-type index-type] . ->opt . -Integer)]
[integer-bytes->integer
(cl->*
;; Any truthy value (not only #t) would work here.
;; We can define a truthy type (without difference types (- Univ #f))
;; by unioning everything (including StructTop and co).
;; We should do this at some point.
(-Bytes (-val #t) [Univ index-type index-type] . ->opt . -Nat)
(-Bytes Univ [Univ index-type index-type] . ->opt . -Integer))]
[peek-char
(cl->* [->opt [-Input-Port index-type] (Un -Char (-val eof))])]

View File

@ -1352,9 +1352,11 @@
(-NonPosInt -Int . -> . (-values (list -Int -NonPosInt)))
(-Int -Int . -> . (-values (list -Int -Int))))]
[arithmetic-shift (cl->* (-Zero (Un -NegFixnum -Zero) . -> . -Zero)
(-NonNegFixnum (Un -NegFixnum -Zero) . -> . -NonNegFixnum)
(-Fixnum (Un -NegFixnum -Zero) . -> . -Fixnum)
[arithmetic-shift (cl->* (-Zero -NonPosInt . -> . -Zero)
(-Byte -NonPosInt . -> . -Byte)
(-Index -NonPosInt . -> . -Index)
(-NonNegFixnum -NonPosInt . -> . -NonNegFixnum)
(-Fixnum -NonPosInt . -> . -Fixnum)
(-Nat -Int . -> . -Nat)
(-Int -Int . -> . -Int))]