From c0970cc647b5aed40e7ff2e6e9272975102796e6 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 19 Jan 2011 17:46:17 -0500 Subject: [PATCH] Small-Float -> Single-Flonum original commit: f1c6c74284fd913ab8231426bcf1206bcf259f77 --- .../typed-scheme/private/base-env-numeric.rkt | 14 ++-- collects/typed-scheme/private/base-types.rkt | 10 +-- .../typed-scheme/private/type-contract.rkt | 8 +- .../typed-scheme/typecheck/tc-expr-unit.rkt | 14 ++-- .../typed-scheme/types/numeric-predicates.rkt | 4 +- collects/typed-scheme/types/numeric-tower.rkt | 74 +++++++++---------- 6 files changed, 61 insertions(+), 63 deletions(-) diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt index 7f6af8b2..f5e8b249 100644 --- a/collects/typed-scheme/private/base-env-numeric.rkt +++ b/collects/typed-scheme/private/base-env-numeric.rkt @@ -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) diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt index bfd92656..44d75e8e 100644 --- a/collects/typed-scheme/private/base-types.rkt +++ b/collects/typed-scheme/private/base-types.rkt @@ -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] diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt index ef43a042..6688b6ce 100644 --- a/collects/typed-scheme/private/type-contract.rkt +++ b/collects/typed-scheme/private/type-contract.rkt @@ -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?))] diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt index f6af9405..189adef4 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt +++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt @@ -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] diff --git a/collects/typed-scheme/types/numeric-predicates.rkt b/collects/typed-scheme/types/numeric-predicates.rkt index bd18c522..d6463a9b 100644 --- a/collects/typed-scheme/types/numeric-predicates.rkt +++ b/collects/typed-scheme/types/numeric-predicates.rkt @@ -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)))) diff --git a/collects/typed-scheme/types/numeric-tower.rkt b/collects/typed-scheme/types/numeric-tower.rkt index 407722a0..f041e3c9 100644 --- a/collects/typed-scheme/types/numeric-tower.rkt +++ b/collects/typed-scheme/types/numeric-tower.rkt @@ -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?