suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Small-Float -> Single-Flonum

Browse Source 
original commit: f1c6c74284fd913ab8231426bcf1206bcf259f77
This commit is contained in:
Vincent St-Amour 2011-01-19 17:46:17 -05:00
parent f642a6ce6d
commit c0970cc647
6 changed files with 61 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/typed-scheme/private/base-env-numeric.rkt
View File

@ -140,7 +140,7 @@
[exact-integer? (make-pred-ty -Integer)]
[real? (make-pred-ty -Real)]
[flonum? (make-pred-ty -Flonum)]
[single-flonum? (make-pred-ty -SmallFloat)]
[single-flonum? (make-pred-ty -SingleFlonum)]
[double-flonum? (make-pred-ty -Flonum)]
[inexact-real? (make-pred-ty -InexactReal)]
[complex? (make-pred-ty N)]
@ -390,12 +390,12 @@
[fl->exact-integer (cl->*
(-NonnegativeFlonum . -> . -Nat)
(-Flonum . -> . -Integer))]
[real->single-flonum (cl->* (-PosReal . -> . -PosSmallFloat)
(-NegReal . -> . -NegSmallFloat)
(-RealZero . -> . -SmallFloatZero)
(-NonNegReal . -> . -NonNegSmallFloat)
(-NonPosReal . -> . -NonPosSmallFloat)
(-Real . -> . -SmallFloat))]
[real->single-flonum (cl->* (-PosReal . -> . -PosSingleFlonum)
(-NegReal . -> . -NegSingleFlonum)
(-RealZero . -> . -SingleFlonumZero)
(-NonNegReal . -> . -NonNegSingleFlonum)
(-NonPosReal . -> . -NonPosSingleFlonum)
(-Real . -> . -SingleFlonumZero))]
[real->double-flonum (cl->* (-PosReal . -> . -PosFlonum)
(-NegReal . -> . -NegFlonum)
(-RealZero . -> . -FlonumZero)

10
collects/typed-scheme/private/base-types.rkt
View File

@ -3,7 +3,7 @@
[Complex -Number]
[Number -Number]
[Inexact-Complex -InexactComplex]
[Small-Float-Complex -SmallFloatComplex]
[Single-Flonum-Complex -SingleFlonumComplex]
[Float-Complex -FloatComplex]
[Real -Real]
[Nonpositive-Real -NonPosReal]
@ -12,17 +12,17 @@
[Positive-Real -PosReal]
[Real-Zero -RealZero]
[Inexact-Real -InexactReal]
[Small-Float -SmallFloat]
[Single-Flonum -SingleFlonum]
[Nonpositive-Inexact-Real -NonPosInexactReal]
[Nonpositive-Small-Float -NonPosSmallFloat]
[Nonpositive-Single-Flonum -NonPosSingleFlonum]
[Negative-Inexact-Real -NegInexactReal]
[Nonnegative-Inexact-Real -NonNegInexactReal]
[Nonnegative-Small-Float -NonNegSmallFloat]
[Nonnegative-Single-Flonum -NonNegSingleFlonum]
[Positive-Inexact-Real -PosInexactReal]
[Inexact-Real-Zero -InexactRealZero]
[Inexact-Real-Negative-Zero -InexactRealNegZero]
[Inexact-Real-Positive-Zero -InexactRealPosZero]
[Small-Float-Zero -SmallFloatZero]
[Single-Flonum-Zero -SingleFlonumZero]
[Float -Flonum] ; these are the default, 64-bit floats, can be optimized
[Nonpositive-Float -NonPosFlonum]
[Nonnegative-Float -NonNegFlonum]

8
collects/typed-scheme/private/type-contract.rkt
View File

@ -148,15 +148,15 @@
[(== t:-NonNegFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Float (and/c flonum? (lambda (x) (>= x 0))))]
[(== t:-NonPosFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Float (and/c flonum? (lambda (x) (<= x 0))))]
[(== t:-Flonum type-equal?) #'(flat-named-contract 'Float flonum?)]
[(== t:-SmallFloatZero type-equal?) #'(flat-named-contract 'Small-Float-Zero (and/c t:small-float? zero?))]
[(== t:-SingleFlonumZero type-equal?) #'(flat-named-contract 'Single-Flonum-Zero (and/c t:single-flonum? zero?))]
[(== t:-InexactRealZero type-equal?) #'(flat-named-contract 'Inexact-Real-Zero (and/c inexact-real? zero?))]
[(== t:-PosInexactReal type-equal?) #'(flat-named-contract 'Positive-Inexact-Real (and/c inexact-real? positive?))]
[(== t:-NonNegSmallFloat type-equal?) #'(flat-named-contract 'Nonnegative-Small-Float (and/c t:small-float? (lambda (x) (>= x 0))))]
[(== t:-NonNegSingleFlonum type-equal?) #'(flat-named-contract 'Nonnegative-Single-Flonum (and/c t:single-flonum? (lambda (x) (>= x 0))))]
[(== t:-NonNegInexactReal type-equal?) #'(flat-named-contract 'Nonnegative-Inexact-Real (and/c inexact-real? (lambda (x) (>= x 0))))]
[(== t:-NegInexactReal type-equal?) #'(flat-named-contract 'Negative-Inexact-Real (and/c inexact-real? negative?))]
[(== t:-NonPosSmallFloat type-equal?) #'(flat-named-contract 'Nonpositive-Small-Float (and/c t:small-float? (lambda (x) (<= x 0))))]
[(== t:-NonPosSingleFlonum type-equal?) #'(flat-named-contract 'Nonpositive-Single-Flonum (and/c t:single-flonum? (lambda (x) (<= x 0))))]
[(== t:-NonPosInexactReal type-equal?) #'(flat-named-contract 'Nonpositive-Inexact-Real (and/c inexact-real? (lambda (x) (<= x 0))))]
[(== t:-SmallFloat type-equal?) #'(flat-named-contract 'Small-Float t:small-float?)]
[(== t:-SingleFlonum type-equal?) #'(flat-named-contract 'Single-Flonum t:single-flonum?)]
[(== t:-InexactReal type-equal?) #'(flat-named-contract 'Inexact-Real inexact-real?)]
[(== t:-RealZero type-equal?) #'(flat-named-contract 'Real-Zero (and/c real? zero?))]
[(== t:-PosReal type-equal?) #'(flat-named-contract 'Positive-Real (and/c real? positive?))]

14
collects/typed-scheme/typecheck/tc-expr-unit.rkt
View File

@ -51,12 +51,12 @@
[(~var i (3d (conjoin flonum? positive?))) -PosFlonum]
[(~var i (3d (conjoin flonum? negative?))) -NegFlonum]
[(~var i (3d flonum?)) -Flonum] ; for nan
;; Small float literals can't be assigned a type normally.
;; Since small floats can't live in a zo, the compilation process
;; promotes them silently to plain floats. Thus, a small float
;; literal can, at runtime turn into either a small float (if the
;; program is not compiled) or a plain float (if it is).
;; That means that if we see a small float literal, we have to
;; Single flonum literals can't be assigned a type normally.
;; Since single flonums can't live in a zo, the compilation process
;; promotes them silently to plain flonums. Thus, a single float
;; literal can, at runtime turn into either a single flonum (if the
;; program is not compiled) or a plain flonum (if it is).
;; That means that if we see a single flonum literal, we have to
;; give it an Inexact-Real type, which covers both cases.
[(~var i (3d (lambda (x) (eq? x 0.0f0)))) -InexactRealPosZero]
[(~var i (3d (lambda (x) (eq? x -0.0f0)))) -InexactRealNegZero]
@ -68,7 +68,7 @@
[(~var i (3d (conjoin number? (lambda (x) (and (flonum? (imag-part x))
(flonum? (real-part x)))))))
-FloatComplex]
;; same issue as small floats
;; same issue as single flonums
[(~var i (3d (conjoin number? (lambda (x) (and (inexact-real? (imag-part x))
(inexact-real? (real-part x)))))))
-InexactComplex]

4
collects/typed-scheme/types/numeric-predicates.rkt
View File

@ -2,7 +2,7 @@
(require unstable/function)
(provide index? exact-rational? small-float?)
(provide index? exact-rational?)
;; this is required for template in numeric-tower.rkt
@ -12,5 +12,3 @@
(define (index? x) (and (fixnum? x) (fixnum? (* x 4))))
(define exact-rational? (conjoin rational? exact?))
(define (small-float? x) (and (inexact-real? x) (not (flonum? x))))

74
collects/typed-scheme/types/numeric-tower.rkt
View File

@ -127,47 +127,47 @@
(define -NonPosFlonum (*Un -NegFlonum -FlonumNegZero))
(define -Flonum (*Un -NegFlonum -FlonumNegZero -FlonumPosZero -PosFlonum -FlonumNan)) ; 64-bit floats
;; inexact reals can be flonums (64-bit floats) or 32-bit floats
(define -SmallFloatPosZero ; disjoint from Flonum 0s
(make-Base 'Small-Float-Positive-Zero
(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 small-float? since eqv? also equates
;; we also need to check for single-flonum? since eqv? also equates
;; 0.0f0 and 0.0e0
#'(and/c small-float? (lambda (x) (eqv? x 0.0f0)))
#'(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
#'-SmallFloatPosZero))
(define -SmallFloatNegZero
(make-Base 'Small-Float-Negative-Zero
#'(and/c small-float? (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)
#'-SmallFloatNegZero))
(define -SmallFloatZero (*Un -SmallFloatPosZero -SmallFloatNegZero))
(define -SmallFloatNan (make-Base 'Small-Float-Nan
#'(and/c small-float?
#'-SingleFlonumNegZero))
(define -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero))
(define -SingleFlonumNan (make-Base 'Single-Flonum-Nan
#'(and/c single-flonum?
;; eqv? equates single and double precision nans
(lambda (x) (eqv? x +nan.0)))
(lambda (x) #f)
#'-SmallFloatNan))
(define -InexactRealPosZero (*Un -SmallFloatPosZero -FlonumPosZero))
(define -InexactRealNegZero (*Un -SmallFloatNegZero -FlonumNegZero))
#'-SingleFlonumNan))
(define -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero))
(define -InexactRealNegZero (*Un -SingleFlonumNegZero -FlonumNegZero))
(define -InexactRealZero (*Un -InexactRealPosZero -InexactRealNegZero))
(define -PosSmallFloat
(make-Base 'Positive-Small-Float
#'(and/c small-float? positive?)
(define -PosSingleFlonum
(make-Base 'Positive-Single-Flonum
#'(and/c single-flonum? positive?)
(lambda (x) #f)
#'-PosSmallFloat))
(define -PosInexactReal (*Un -PosSmallFloat -PosFlonum))
(define -NonNegSmallFloat (*Un -PosSmallFloat -SmallFloatPosZero))
#'-PosSingleFlonum))
(define -PosInexactReal (*Un -PosSingleFlonum -PosFlonum))
(define -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumPosZero))
(define -NonNegInexactReal (*Un -PosInexactReal -InexactRealPosZero))
(define -NegSmallFloat
(make-Base 'Negative-Small-Float
#'(and/c small-float? negative?)
(define -NegSingleFlonum
(make-Base 'Negative-Single-Flonum
#'(and/c single-flonum? negative?)
(lambda (x) #f)
#'-NegSmallFloat))
(define -NegInexactReal (*Un -NegSmallFloat -NegFlonum))
(define -NonPosSmallFloat (*Un -NegSmallFloat -SmallFloatNegZero))
#'-NegSingleFlonum))
(define -NegInexactReal (*Un -NegSingleFlonum -NegFlonum))
(define -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero))
(define -NonPosInexactReal (*Un -NegInexactReal -InexactRealNegZero))
(define -SmallFloat (*Un -NegSmallFloat -SmallFloatNegZero -SmallFloatPosZero -PosSmallFloat -SmallFloatNan))
(define -InexactReal (*Un -SmallFloat -Flonum))
(define -SingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero -SingleFlonumPosZero -PosSingleFlonum -SingleFlonumNan))
(define -InexactReal (*Un -SingleFlonum -Flonum))
;; Reals
(define -RealZero (*Un -Zero -InexactRealZero))
@ -190,7 +190,7 @@
;; Both parts of a complex number must be of the same exactness.
;; Thus, the only possible kinds of complex numbers are:
;; Real/Real, Flonum/Flonum, SmallFloat/SmallFloat
;; Real/Real, Flonum/Flonum, SingleFlonum/SingleFlonum
(define -FloatComplex (make-Base 'Float-Complex
#'(and/c number?
(lambda (x)
@ -201,17 +201,17 @@
(and (flonum? (imag-part x))
(flonum? (real-part x)))))
#'-FloatComplex))
(define -SmallFloatComplex (make-Base 'Small-Float-Complex
(define -SingleFlonumComplex (make-Base 'Single-Flonum-Complex
#'(and/c number?
(lambda (x)
(and (small-float? (imag-part x))
(small-float? (real-part x)))))
(and (single-flonum? (imag-part x))
(single-flonum? (real-part x)))))
(conjoin number?
(lambda (x)
(and (small-float? (imag-part x))
(small-float? (real-part x)))))
#'-SmallFloatComplex))
(define -InexactComplex (*Un -FloatComplex -SmallFloatComplex))
(and (single-flonum? (imag-part x))
(single-flonum? (real-part x)))))
#'-SingleFlonumComplex))
(define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
(define -ExactComplexNotReal
(make-Base 'Complex-Not-Real
#'(and/c number?