From a8a37a78ebdcc904b5e48c9f41b0beae0d80213c Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 6 Feb 2013 23:24:43 -0800 Subject: [PATCH] Make static single flonum checks correct. Closes PR13499. original commit: 9030da217bd79249ef694f262a26ede8470180da --- .../typed-racket/unit-tests/subtype-tests.rkt | 3 +++ collects/typed-racket/types/numeric-tower.rkt | 22 +++++++++---------- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/collects/tests/typed-racket/unit-tests/subtype-tests.rkt b/collects/tests/typed-racket/unit-tests/subtype-tests.rkt index 40aec569..2d7c1756 100644 --- a/collects/tests/typed-racket/unit-tests/subtype-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/subtype-tests.rkt @@ -138,6 +138,9 @@ [(-struct #'a #f null) (-struct #'a #f null)] [(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld -String #'values #f)))] [(-struct #'a #f (list (make-fld -String #'values #f))) (-struct #'a #f (list (make-fld Univ #'values #f)))] + [(-val 0.0f0) -SingleFlonum] + [(-val -0.0f0) -SingleFlonum] + [(-val 1.0f0) -SingleFlonum] )) (define-go diff --git a/collects/typed-racket/types/numeric-tower.rkt b/collects/typed-racket/types/numeric-tower.rkt index 2e9af731..31234fc5 100644 --- a/collects/typed-racket/types/numeric-tower.rkt +++ b/collects/typed-racket/types/numeric-tower.rkt @@ -183,16 +183,14 @@ (define -SingleFlonumPosZero ; disjoint from Flonum 0s (make-Base 'Single-Flonum-Positive-Zero ;; eqv? equates 0.0f0 with itself, but not eq? - ;; we also need to check for single-flonum? since eqv? also equates - ;; 0.0f0 and 0.0e0 - #'(and/c single-flonum? (lambda (x) (eqv? x 0.0f0))) - (lambda (x) #f) ; can't assign that type at compile-time. see tc-lit for more explanation - #'-SingleFlonumPosZero)) + #'(lambda (x) (eqv? x 0.0f0)) + (lambda (x) (eqv? x 0.0f0)) + #'-SingleFlonumPosZero)) (define -SingleFlonumNegZero (make-Base 'Single-Flonum-Negative-Zero - #'(and/c single-flonum? (lambda (x) (eqv? x -0.0f0))) - (lambda (x) #f) - #'-SingleFlonumNegZero)) + #'(lambda (x) (eqv? x -0.0f0)) + (lambda (x) (eqv? x -0.0f0)) + #'-SingleFlonumNegZero)) (define -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumNan)) (define -InexactRealNan (*Un -FlonumNan -SingleFlonumNan)) (define -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero)) @@ -203,8 +201,8 @@ (define -PosSingleFlonumNoNan (make-Base 'Positive-Single-Flonum-No-Nan #'(and/c single-flonum? positive?) - (lambda (x) #f) - #'-PosSingleFlonumNoNan)) + (lambda (x) (and (single-flonum? x) (positive? x))) + #'-PosSingleFlonumNoNan)) (define -PosSingleFlonum (*Un -PosSingleFlonumNoNan -SingleFlonumNan)) (define -PosInexactReal (*Un -PosSingleFlonum -PosFlonum)) (define -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumZero)) @@ -212,8 +210,8 @@ (define -NegSingleFlonumNoNan (make-Base 'Negative-Single-Flonum-No-Nan #'(and/c single-flonum? negative?) - (lambda (x) #f) - #'-NegSingleFlonumNoNan)) + (lambda (x) (and (single-flonum? x) (positive? x))) + #'-NegSingleFlonumNoNan)) (define -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan)) (define -NegInexactReal (*Un -NegSingleFlonum -NegFlonum)) (define -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumZero))