From f7e8b090e6e6e2f6d5be7687878e407ee923b29b Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Mon, 18 Mar 2013 15:30:16 -0400 Subject: [PATCH] Fix types of bitwise-and and bitwise-xor. Found with random testing. --- .../base-env/base-env-numeric.rkt | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/collects/typed-racket/base-env/base-env-numeric.rkt b/collects/typed-racket/base-env/base-env-numeric.rkt index aee19ef37b..64ae89644f 100644 --- a/collects/typed-racket/base-env/base-env-numeric.rkt +++ b/collects/typed-racket/base-env/base-env-numeric.rkt @@ -1473,15 +1473,15 @@ [bitwise-and (let ([mix-with-int (lambda (t) - (list (->* null t t) ; closed - (->* (list -Int) t t) ; brings result down + (list (->* (list t) t t) ; closed + (->* (list -Int t) t t) ; brings result down (->* (list t -Int) t t)))]) (from-cases (-> -NegFixnum) ; no args -> -1 (map mix-with-int (list -Zero -Byte -Index -NonNegFixnum)) ;; closed on negatives, but not closed if we mix with positives - (map varop (list -NegFixnum -NonPosFixnum)) + (map varop-1+ (list -NegFixnum -NonPosFixnum)) (map mix-with-int (list -Fixnum -Nat)) - (map varop (list -NegInt -NonPosInt)) + (map varop-1+ (list -NegInt -NonPosInt)) (null -Int . ->* . -Int)))] [bitwise-ior (from-cases (varop -Zero) @@ -1510,18 +1510,18 @@ (-> -One -One) (-> -One -One -Zero) (-> -One -One -One -One) - (map varop (list -Zero -Byte -Index -NonNegFixnum)) + (map varop-1+ (list -Zero -Byte -Index -NonNegFixnum)) (-> -NegFixnum -NegFixnum) (-> -NonPosFixnum -NonPosFixnum) - (-> -NonPosFixnum -NonPosFixnum -NonNegFixnum) + (-> -NegFixnum -NegFixnum -NonNegFixnum) ; both have to be negative: (0 -1) -> -1 (commutative-binop -NegFixnum -NonNegFixnum -NegFixnum) - (commutative-binop -NonPosFixnum -NonNegFixnum -NonPosFixnum) - (map varop (list -Fixnum -Nat)) + (-> -NegFixnum -NonNegFixnum -NonPosFixnum) ; not commutative: ( (ann 0 )) -> + (map varop-1+ (list -Fixnum -Nat)) (-> -NegInt -NegInt) (-> -NonPosInt -NonPosInt) - (-> -NonPosInt -NonPosInt -Nat) + (-> -NegInt -NegInt -Nat) (commutative-binop -NegInt -Nat -NegInt) - (commutative-binop -NonPosInt -Nat -NonPosInt) + (-> -NegInt -Nat -NonPosInt) ; see above (varop -Int))] [bitwise-bit-set? (-> -Int -Int B)] [bitwise-bit-field