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

Eta-expand typechecking of literals, to improve performance.

Browse Source
This commit is contained in:
Vincent St-Amour 2011-06-06 21:00:48 -04:00
parent 44d591b5ba
commit 7f55680028
1 changed files with 34 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -61,28 +61,35 @@
;; index? will be checked at runtime, can be platform-specific ;; index? will be checked at runtime, can be platform-specific
;; portable-index? will be checked at compile-time, must be portable ;; portable-index? will be checked at compile-time, must be portable
#'(and/c index? positive? (not/c byte?)) #'(and/c index? positive? (not/c byte?))
(conjoin portable-index? positive? (negate byte?)) (lambda (x) (and (portable-index? x)
(positive? x)
(not (byte? x))))
#'-PosIndexNotByte)) #'-PosIndexNotByte))
(define -PosIndex (*Un -One -Byte>1 -PosIndexNotByte)) (define -PosIndex (*Un -One -Byte>1 -PosIndexNotByte))
(define -Index (*Un -Zero -PosIndex)) (define -Index (*Un -Zero -PosIndex))
(define -PosFixnumNotIndex (define -PosFixnumNotIndex
(make-Base 'Positive-Fixnum-Not-Index (make-Base 'Positive-Fixnum-Not-Index
#'(and/c fixnum? positive? (not/c index?)) #'(and/c fixnum? positive? (not/c index?))
(conjoin portable-fixnum? positive? (negate portable-index?)) (lambda (x) (and (portable-fixnum? x)
(positive? x)
(not (portable-index? x))))
#'-PosFixnumNotIndex)) #'-PosFixnumNotIndex))
(define -PosFixnum (*Un -PosFixnumNotIndex -PosIndex)) (define -PosFixnum (*Un -PosFixnumNotIndex -PosIndex))
(define -NonNegFixnum (*Un -PosFixnum -Zero)) (define -NonNegFixnum (*Un -PosFixnum -Zero))
(define -NegFixnum (define -NegFixnum
(make-Base 'Negative-Fixnum (make-Base 'Negative-Fixnum
#'(and/c fixnum? negative?) #'(and/c fixnum? negative?)
(conjoin portable-fixnum? negative?) (lambda (x) (and (portable-fixnum? x)
(negative? x)))
#'-NegFixnum)) #'-NegFixnum))
(define -NonPosFixnum (*Un -NegFixnum -Zero)) (define -NonPosFixnum (*Un -NegFixnum -Zero))
(define -Fixnum (*Un -NegFixnum -Zero -PosFixnum)) (define -Fixnum (*Un -NegFixnum -Zero -PosFixnum))
(define -PosIntNotFixnum (define -PosIntNotFixnum
(make-Base 'Positive-Integer-Not-Fixnum (make-Base 'Positive-Integer-Not-Fixnum
#'(and/c exact-integer? positive? (not/c fixnum?)) #'(and/c exact-integer? positive? (not/c fixnum?))
(conjoin exact-integer? positive? (negate portable-fixnum?)) (lambda (x) (and (exact-integer? x)
(positive? x)
(not (portable-fixnum? x))))
#'-PosIntNotFixnum)) #'-PosIntNotFixnum))
(define -PosInt (*Un -PosIntNotFixnum -PosFixnum)) (define -PosInt (*Un -PosIntNotFixnum -PosFixnum))
(define -NonNegInt (*Un -PosInt -Zero)) (define -NonNegInt (*Un -PosInt -Zero))
@ -90,7 +97,9 @@
(define -NegIntNotFixnum (define -NegIntNotFixnum
(make-Base 'Negative-Integer-Not-Fixnum (make-Base 'Negative-Integer-Not-Fixnum
#'(and/c exact-integer? negative? (not/c fixnum?)) #'(and/c exact-integer? negative? (not/c fixnum?))
(conjoin exact-integer? negative? (negate portable-fixnum?)) (lambda (x) (and (exact-integer? x)
(negative? x)
(not (portable-fixnum? x))))
#'-NegIntNotFixnum)) #'-NegIntNotFixnum))
(define -NegInt (*Un -NegIntNotFixnum -NegFixnum)) (define -NegInt (*Un -NegIntNotFixnum -NegFixnum))
(define -NonPosInt (*Un -NegInt -Zero)) (define -NonPosInt (*Un -NegInt -Zero))
@ -100,14 +109,18 @@
(define -PosRatNotInt (define -PosRatNotInt
(make-Base 'Positive-Rational-Not-Integer (make-Base 'Positive-Rational-Not-Integer
#'(and/c exact-rational? positive? (not/c integer?)) #'(and/c exact-rational? positive? (not/c integer?))
(conjoin exact-rational? positive? (negate integer?)) (lambda (x) (and (exact-rational? x)
(positive? x)
(not (exact-integer? x))))
#'-PosRatNotInt)) #'-PosRatNotInt))
(define -PosRat (*Un -PosRatNotInt -PosInt)) (define -PosRat (*Un -PosRatNotInt -PosInt))
(define -NonNegRat (*Un -PosRat -Zero)) (define -NonNegRat (*Un -PosRat -Zero))
(define -NegRatNotInt (define -NegRatNotInt
(make-Base 'Negative-Rational-Not-Integer (make-Base 'Negative-Rational-Not-Integer
#'(and/c exact-rational? negative? (not/c integer?)) #'(and/c exact-rational? negative? (not/c integer?))
(conjoin exact-rational? negative? (negate integer?)) (lambda (x) (and (exact-rational? x)
(negative? x)
(not (exact-integer? x))))
#'-NegRatNotInt)) #'-NegRatNotInt))
(define -NegRat (*Un -NegRatNotInt -NegInt)) (define -NegRat (*Un -NegRatNotInt -NegInt))
(define -NonPosRat (*Un -NegRat -Zero)) (define -NonPosRat (*Un -NegRat -Zero))
@ -125,18 +138,18 @@
(define -FlonumZero (*Un -FlonumPosZero -FlonumNegZero)) (define -FlonumZero (*Un -FlonumPosZero -FlonumNegZero))
(define -FlonumNan (make-Base 'Float-Nan (define -FlonumNan (make-Base 'Float-Nan
#'(and/c flonum? (lambda (x) (eqv? x +nan.0))) #'(and/c flonum? (lambda (x) (eqv? x +nan.0)))
(conjoin flonum? (lambda (x) (eqv? x +nan.0))) (lambda (x) (and (flonum? x) (eqv? x +nan.0)))
#'-FlonumNan)) #'-FlonumNan))
(define -PosFlonum (define -PosFlonum
(make-Base 'Positive-Float (make-Base 'Positive-Float
#'(and/c flonum? positive?) #'(and/c flonum? positive?)
(conjoin flonum? positive?) (lambda (x) (and (flonum? x) (positive? x)))
#'-PosFlonum)) #'-PosFlonum))
(define -NonNegFlonum (*Un -PosFlonum -FlonumPosZero)) (define -NonNegFlonum (*Un -PosFlonum -FlonumPosZero))
(define -NegFlonum (define -NegFlonum
(make-Base 'Negative-Float (make-Base 'Negative-Float
#'(and/c flonum? negative?) #'(and/c flonum? negative?)
(conjoin flonum? negative?) (lambda (x) (and (flonum? x) (negative? x)))
#'-NegFlonum)) #'-NegFlonum))
(define -NonPosFlonum (*Un -NegFlonum -FlonumNegZero)) (define -NonPosFlonum (*Un -NegFlonum -FlonumNegZero))
(define -Flonum (*Un -NegFlonum -FlonumNegZero -FlonumPosZero -PosFlonum -FlonumNan)) ; 64-bit floats (define -Flonum (*Un -NegFlonum -FlonumNegZero -FlonumPosZero -PosFlonum -FlonumNan)) ; 64-bit floats
@ -210,9 +223,9 @@
#'(and/c number? #'(and/c number?
(not/c real?) (not/c real?)
(lambda (x) (exact? (imag-part x)))) (lambda (x) (exact? (imag-part x))))
(conjoin number? (lambda (x) (and (number? x)
(negate real?) (not (real? x))
(lambda (x) (exact? (imag-part x)))) (exact? (imag-part x))))
#'-ExactNumberNotReal)) #'-ExactNumberNotReal))
(define -ExactNumber (*Un -ExactNumberNotReal -Rat)) (define -ExactNumber (*Un -ExactNumberNotReal -Rat))
(define -FloatComplex (make-Base 'Float-Complex (define -FloatComplex (make-Base 'Float-Complex
@ -220,20 +233,20 @@
(lambda (x) (lambda (x)
(and (flonum? (imag-part x)) (and (flonum? (imag-part x))
(flonum? (real-part x))))) (flonum? (real-part x)))))
(conjoin number? (lambda (x)
(lambda (x) (and (number? x)
(and (flonum? (imag-part x)) (flonum? (imag-part x))
(flonum? (real-part x))))) (flonum? (real-part x))))
#'-FloatComplex)) #'-FloatComplex))
(define -SingleFlonumComplex (make-Base 'Single-Flonum-Complex (define -SingleFlonumComplex (make-Base 'Single-Flonum-Complex
#'(and/c number? #'(and/c number?
(lambda (x) (lambda (x)
(and (single-flonum? (imag-part x)) (and (single-flonum? (imag-part x))
(single-flonum? (real-part x))))) (single-flonum? (real-part x)))))
(conjoin number? (lambda (x)
(lambda (x) (and (number? x)
(and (single-flonum? (imag-part x)) (single-flonum? (imag-part x))
(single-flonum? (real-part x))))) (single-flonum? (real-part x))))
#'-SingleFlonumComplex)) #'-SingleFlonumComplex))
(define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex)) (define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
(define -Complex (*Un -Real -InexactComplex -ExactNumberNotReal)) (define -Complex (*Un -Real -InexactComplex -ExactNumberNotReal))