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

Remember types that are defined, and use them in serialization.

Browse Source 
This extends a facility already available for base types,
making that facility no longer strictly needed.

Shrinks the zo size for the `math` package by almost 1MB.
This commit is contained in:
Sam Tobin-Hochstadt 2013-09-06 14:22:04 -04:00
parent 23814ec5b3
commit 56b372ca4d
6 changed files with 103 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/init-envs.rkt vendored
View File

@ -48,6 +48,7 @@
(define (gen-constructor sym) (define (gen-constructor sym)
(string->symbol (string-append "make-" (substring (symbol->string sym) 7)))) (string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
(match v (match v
[(? Rep? (app (lambda (v) (hash-ref predefined-type-table (Rep-seq v) #f)) (? values id))) id]
[(Union: elems) `(make-Union (sort (list ,@(map sub elems)) < #:key Type-seq))] [(Union: elems) `(make-Union (sort (list ,@(map sub elems)) < #:key Type-seq))]
[(Base: n cnt pred marshaled _) marshaled] [(Base: n cnt pred marshaled _) marshaled]
[(Name: stx) `(make-Name (quote-syntax ,stx))] [(Name: stx) `(make-Name (quote-syntax ,stx))]

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/def-export.rkt
View File

@ -9,6 +9,7 @@
(syntax-parse stx (syntax-parse stx
[(def-export export-id:identifier id:identifier cnt-id:identifier) [(def-export export-id:identifier id:identifier cnt-id:identifier)
#'(define-syntax export-id #'(define-syntax export-id
(let ([c #'cnt-id])
(if (unbox typed-context?) (if (unbox typed-context?)
(renamer #'id #'cnt-id) (renamer #'id c)
(renamer #'cnt-id)))])) (renamer c))))]))

5
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt
View File

@ -380,9 +380,10 @@
#`(begin #`(begin
(begin-for-syntax (begin-for-syntax
(module* #%type-decl #f (module* #%type-decl #f
(#%plain-module-begin ;; avoid top-level printing and config
(require typed-racket/types/numeric-tower typed-racket/env/type-name-env (require typed-racket/types/numeric-tower typed-racket/env/type-name-env
typed-racket/env/global-env typed-racket/env/type-alias-env typed-racket/env/global-env typed-racket/env/type-alias-env
typed-racket/types/type-table) typed-racket/types/type-table typed-racket/types/abbrev)
#,(env-init-code syntax-provide? provide-tbl def-tbl) #,(env-init-code syntax-provide? provide-tbl def-tbl)
#,(talias-env-init-code) #,(talias-env-init-code)
#,(tname-env-init-code) #,(tname-env-init-code)
@ -392,7 +393,7 @@
#,@(for/list ([a (in-list aliases)]) #,@(for/list ([a (in-list aliases)])
(match a (match a
[(list from to) [(list from to)
#`(add-alias (quote-syntax #,from) (quote-syntax #,to))])))) #`(add-alias (quote-syntax #,from) (quote-syntax #,to))])))))
(begin-for-syntax (add-mod! (variable-reference->module-path-index (begin-for-syntax (add-mod! (variable-reference->module-path-index
(#%variable-reference))))) (#%variable-reference)))))
#`(begin #`(begin

36
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt
View File

@ -83,7 +83,7 @@
(define -Listof (-poly (list-elem) (make-Listof list-elem))) (define -Listof (-poly (list-elem) (make-Listof list-elem)))
(define -Boolean (Un (-val #t) (-val #f))) (define/decl -Boolean (Un (-val #t) (-val #f)))
(define -Undefined (define -Undefined
(make-Base 'Undefined (make-Base 'Undefined
#'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings #'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings
@ -101,14 +101,14 @@
#'-PRegexp)) #'-PRegexp))
(define -Regexp (Un -PRegexp -Base-Regexp)) (define -Regexp (Un -PRegexp -Base-Regexp))
(define -Byte-Base-Regexp (make-Base 'Byte-Regexp (define -Byte-Base-Regexp (make-Base 'Byte-Base-Regexp
#'(and/c byte-regexp? (not/c byte-pregexp?)) #'(and/c byte-regexp? (not/c byte-pregexp?))
(conjoin byte-regexp? (negate byte-pregexp?)) (conjoin byte-regexp? (negate byte-pregexp?))
#'-Byte-Regexp)) #'-Byte-Base-Regexp))
(define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp)) (define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp))
(define -Byte-Regexp (Un -Byte-Base-Regexp -Byte-PRegexp)) (define -Byte-Regexp (Un -Byte-Base-Regexp -Byte-PRegexp))
(define -Pattern (Un -Bytes -Regexp -Byte-Regexp -String)) (define/decl -Pattern (Un -Bytes -Regexp -Byte-Regexp -String))
@ -119,7 +119,7 @@
(define -Keyword (make-Base 'Keyword #'keyword? keyword? #'-Keyword)) (define -Keyword (make-Base 'Keyword #'keyword? keyword? #'-Keyword))
(define -Thread (make-Base 'Thread #'thread? thread? #'-Thread)) (define -Thread (make-Base 'Thread #'thread? thread? #'-Thread))
(define -Module-Path (Un -Symbol -String (define/decl -Module-Path (Un -Symbol -String
(-lst* (-val 'quote) -Symbol) (-lst* (-val 'quote) -Symbol)
(-lst* (-val 'lib) -String) (-lst* (-val 'lib) -String)
(-lst* (-val 'file) -String) (-lst* (-val 'file) -String)
@ -135,7 +135,7 @@
#'(and/c compiled-expression? (not/c compiled-module-expression?)) #'(and/c compiled-expression? (not/c compiled-module-expression?))
(conjoin compiled-expression? (negate compiled-module-expression?)) (conjoin compiled-expression? (negate compiled-module-expression?))
#'-Compiled-Non-Module-Expression)) #'-Compiled-Non-Module-Expression))
(define -Compiled-Expression (Un -Compiled-Module-Expression -Compiled-Non-Module-Expression)) (define/decl -Compiled-Expression (Un -Compiled-Module-Expression -Compiled-Non-Module-Expression))
(define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set)) (define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set))
(define -Path (make-Base 'Path #'path? path? #'-Path)) (define -Path (make-Base 'Path #'path? path? #'-Path))
(define -OtherSystemPath (make-Base 'OtherSystemPath (define -OtherSystemPath (make-Base 'OtherSystemPath
@ -170,7 +170,7 @@
(make-Box sexp) (make-Box sexp)
t))) t)))
(define -Sexp (-Sexpof (Un))) (define/decl -Sexp (-Sexpof (Un)))
(define Syntax-Sexp (-Sexpof Any-Syntax)) (define Syntax-Sexp (-Sexpof Any-Syntax))
@ -185,14 +185,14 @@
(define -VectorTop (make-VectorTop)) (define -VectorTop (make-VectorTop))
(define -Port (Un -Output-Port -Input-Port)) (define/decl -Port (Un -Output-Port -Input-Port))
(define -SomeSystemPath (Un -Path -OtherSystemPath)) (define/decl -SomeSystemPath (Un -Path -OtherSystemPath))
(define -Pathlike (Un -String -Path)) (define/decl -Pathlike (Un -String -Path))
(define -SomeSystemPathlike (Un -String -SomeSystemPath)) (define/decl -SomeSystemPathlike (Un -String -SomeSystemPath))
(define -Pathlike* (Un -String -Path (-val 'up) (-val 'same))) (define/decl -Pathlike* (Un -String -Path (-val 'up) (-val 'same)))
(define -SomeSystemPathlike* (Un -String -SomeSystemPath(-val 'up) (-val 'same))) (define/decl -SomeSystemPathlike* (Un -String -SomeSystemPath(-val 'up) (-val 'same)))
(define -PathConventionType (Un (-val 'unix) (-val 'windows))) (define/decl -PathConventionType (Un (-val 'unix) (-val 'windows)))
@ -244,7 +244,7 @@
(define -Logger (make-Base 'Logger #'logger? logger? #'-Logger)) (define -Logger (make-Base 'Logger #'logger? logger? #'-Logger))
(define -Log-Receiver (make-Base 'LogReceiver #'log-receiver? log-receiver? #'-Log-Receiver)) (define -Log-Receiver (make-Base 'LogReceiver #'log-receiver? log-receiver? #'-Log-Receiver))
(define -Log-Level (one-of/c 'fatal 'error 'warning 'info 'debug)) (define/decl -Log-Level (one-of/c 'fatal 'error 'warning 'info 'debug))
(define -Place (define -Place
@ -252,7 +252,7 @@
(define -Base-Place-Channel (define -Base-Place-Channel
(make-Base 'Base-Place-Channel #'(and/c place-channel? (not/c place?)) (conjoin place-channel? (negate place?)) #'-Base-Place-Channel)) (make-Base 'Base-Place-Channel #'(and/c place-channel? (not/c place?)) (conjoin place-channel? (negate place?)) #'-Base-Place-Channel))
(define -Place-Channel (Un -Place -Base-Place-Channel)) (define/decl -Place-Channel (Un -Place -Base-Place-Channel))
(define -Will-Executor (define -Will-Executor
(make-Base 'Will-Executor #'will-executor? will-executor? #'-Will-Executor)) (make-Base 'Will-Executor #'will-executor? will-executor? #'-Will-Executor))
@ -297,8 +297,8 @@
[(t) [(t)
(make-pred-ty (list Univ) -Boolean t 0 null)])) (make-pred-ty (list Univ) -Boolean t 0 null)]))
(define -true-filter (-FS -top -bot)) (define/decl -true-filter (-FS -top -bot))
(define -false-filter (-FS -bot -top)) (define/decl -false-filter (-FS -bot -top))
(define (opt-fn args opt-args result) (define (opt-fn args opt-args result)
(apply cl->* (for/list ([i (in-range (add1 (length opt-args)))]) (apply cl->* (for/list ([i (in-range (add1 (length opt-args)))])

12
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt
View File

@ -13,9 +13,17 @@
(rename-out [make-Listof -lst] (rename-out [make-Listof -lst]
[make-MListof -mlst])) [make-MListof -mlst]))
(define predefined-type-table (make-hasheq))
(define-syntax-rule (declare-predefined-type! id)
(hash-set! predefined-type-table (Rep-seq id) #'id))
(provide predefined-type-table)
(define-syntax-rule (define/decl id e)
(begin (define id e)
(declare-predefined-type! id)))
;Top and error types ;Top and error types
(define Univ (make-Univ)) (define/decl Univ (make-Univ))
(define -Bottom (make-Union null)) (define/decl -Bottom (make-Union null))
(define Err (make-Error)) (define Err (make-Error))
;A Type that corresponds to the any contract for the ;A Type that corresponds to the any contract for the

108
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/numeric-tower.rkt
View File

@ -50,16 +50,16 @@
(>= n 0))) (>= n 0)))
;; Singletons ;; Singletons
(define -Zero (make-Value 0)) ; exact (define/decl -Zero (make-Value 0)) ; exact
(define -One (make-Value 1)) (define/decl -One (make-Value 1))
;; Integers ;; Integers
(define -Byte>1 (make-Base 'Byte-Larger-Than-One ; unsigned (define -Byte>1 (make-Base 'Byte-Larger-Than-One ; unsigned
#'(and/c byte? (lambda (x) (> x 1))) #'(and/c byte? (lambda (x) (> x 1)))
(conjoin byte? (lambda (x) (> x 1))) (conjoin byte? (lambda (x) (> x 1)))
#'-Byte>1)) #'-Byte>1))
(define -PosByte (*Un -One -Byte>1)) (define/decl -PosByte (*Un -One -Byte>1))
(define -Byte (*Un -Zero -PosByte)) (define/decl -Byte (*Un -Zero -PosByte))
(define -PosIndexNotByte (define -PosIndexNotByte
(make-Base 'Positive-Index-Not-Byte (make-Base 'Positive-Index-Not-Byte
;; index? will be checked at runtime, can be platform-specific ;; index? will be checked at runtime, can be platform-specific
@ -69,8 +69,8 @@
(positive? x) (positive? x)
(not (byte? x)))) (not (byte? x))))
#'-PosIndexNotByte)) #'-PosIndexNotByte))
(define -PosIndex (*Un -One -Byte>1 -PosIndexNotByte)) (define/decl -PosIndex (*Un -One -Byte>1 -PosIndexNotByte))
(define -Index (*Un -Zero -PosIndex)) (define/decl -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?))
@ -78,16 +78,16 @@
(positive? x) (positive? x)
(not (portable-index? x)))) (not (portable-index? x))))
#'-PosFixnumNotIndex)) #'-PosFixnumNotIndex))
(define -PosFixnum (*Un -PosFixnumNotIndex -PosIndex)) (define/decl -PosFixnum (*Un -PosFixnumNotIndex -PosIndex))
(define -NonNegFixnum (*Un -PosFixnum -Zero)) (define/decl -NonNegFixnum (*Un -PosFixnum -Zero))
(define -NegFixnum (define -NegFixnum
(make-Base 'Negative-Fixnum (make-Base 'Negative-Fixnum
#'(and/c fixnum? negative?) #'(and/c fixnum? negative?)
(lambda (x) (and (portable-fixnum? x) (lambda (x) (and (portable-fixnum? x)
(negative? x))) (negative? x)))
#'-NegFixnum)) #'-NegFixnum))
(define -NonPosFixnum (*Un -NegFixnum -Zero)) (define/decl -NonPosFixnum (*Un -NegFixnum -Zero))
(define -Fixnum (*Un -NegFixnum -Zero -PosFixnum)) (define/decl -Fixnum (*Un -NegFixnum -Zero -PosFixnum))
;; This type, and others like it, should *not* be exported, or used for ;; This type, and others like it, should *not* be exported, or used for
;; anything but building unions. Especially, no literals should be given ;; anything but building unions. Especially, no literals should be given
;; these types. ;; these types.
@ -98,9 +98,9 @@
(positive? x) (positive? x)
(not (portable-fixnum? x)))) (not (portable-fixnum? x))))
#'-PosIntNotFixnum)) #'-PosIntNotFixnum))
(define -PosInt (*Un -PosIntNotFixnum -PosFixnum)) (define/decl -PosInt (*Un -PosIntNotFixnum -PosFixnum))
(define -NonNegInt (*Un -PosInt -Zero)) (define/decl -NonNegInt (*Un -PosInt -Zero))
(define -Nat -NonNegInt) (define/decl -Nat -NonNegInt)
(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?))
@ -108,9 +108,9 @@
(negative? x) (negative? x)
(not (portable-fixnum? x)))) (not (portable-fixnum? x))))
#'-NegIntNotFixnum)) #'-NegIntNotFixnum))
(define -NegInt (*Un -NegIntNotFixnum -NegFixnum)) (define/decl -NegInt (*Un -NegIntNotFixnum -NegFixnum))
(define -NonPosInt (*Un -NegInt -Zero)) (define/decl -NonPosInt (*Un -NegInt -Zero))
(define -Int (*Un -NegInt -Zero -PosInt)) (define/decl -Int (*Un -NegInt -Zero -PosInt))
;; Rationals ;; Rationals
(define -PosRatNotInt (define -PosRatNotInt
@ -120,8 +120,8 @@
(positive? x) (positive? x)
(not (exact-integer? x)))) (not (exact-integer? x))))
#'-PosRatNotInt)) #'-PosRatNotInt))
(define -PosRat (*Un -PosRatNotInt -PosInt)) (define/decl -PosRat (*Un -PosRatNotInt -PosInt))
(define -NonNegRat (*Un -PosRat -Zero)) (define/decl -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?))
@ -129,9 +129,9 @@
(negative? x) (negative? x)
(not (exact-integer? x)))) (not (exact-integer? x))))
#'-NegRatNotInt)) #'-NegRatNotInt))
(define -NegRat (*Un -NegRatNotInt -NegInt)) (define/decl -NegRat (*Un -NegRatNotInt -NegInt))
(define -NonPosRat (*Un -NegRat -Zero)) (define/decl -NonPosRat (*Un -NegRat -Zero))
(define -Rat (*Un -NegRat -Zero -PosRat)) (define/decl -Rat (*Un -NegRat -Zero -PosRat))
;; Floating-point numbers ;; Floating-point numbers
;; NaN is included in all floating-point types ;; NaN is included in all floating-point types
@ -147,22 +147,22 @@
#'(lambda (x) (eqv? x -0.0)) #'(lambda (x) (eqv? x -0.0))
(lambda (x) (eqv? x -0.0)) (lambda (x) (eqv? x -0.0))
#'-FlonumNegZero)) #'-FlonumNegZero))
(define -FlonumZero (*Un -FlonumPosZero -FlonumNegZero -FlonumNan)) (define/decl -FlonumZero (*Un -FlonumPosZero -FlonumNegZero -FlonumNan))
(define -PosFlonumNoNan (define -PosFlonumNoNan
(make-Base 'Positive-Float-No-NaN (make-Base 'Positive-Float-No-NaN
#'(and/c flonum? positive?) #'(and/c flonum? positive?)
(lambda (x) (and (flonum? x) (positive? x))) (lambda (x) (and (flonum? x) (positive? x)))
#'-PosFlonumNoNan)) #'-PosFlonumNoNan))
(define -PosFlonum (*Un -PosFlonumNoNan -FlonumNan)) (define/decl -PosFlonum (*Un -PosFlonumNoNan -FlonumNan))
(define -NonNegFlonum (*Un -PosFlonum -FlonumZero)) (define/decl -NonNegFlonum (*Un -PosFlonum -FlonumZero))
(define -NegFlonumNoNan (define -NegFlonumNoNan
(make-Base 'Negative-Float-No-NaN (make-Base 'Negative-Float-No-NaN
#'(and/c flonum? negative?) #'(and/c flonum? negative?)
(lambda (x) (and (flonum? x) (negative? x))) (lambda (x) (and (flonum? x) (negative? x)))
#'-NegFlonumNoNan)) #'-NegFlonumNoNan))
(define -NegFlonum (*Un -NegFlonumNoNan -FlonumNan)) (define/decl -NegFlonum (*Un -NegFlonumNoNan -FlonumNan))
(define -NonPosFlonum (*Un -NegFlonum -FlonumZero)) (define/decl -NonPosFlonum (*Un -NegFlonum -FlonumZero))
(define -Flonum (*Un -NegFlonumNoNan -FlonumNegZero -FlonumPosZero -PosFlonumNoNan -FlonumNan)) ; 64-bit floats (define/decl -Flonum (*Un -NegFlonumNoNan -FlonumNegZero -FlonumPosZero -PosFlonumNoNan -FlonumNan)) ; 64-bit floats
;; inexact reals can be flonums (64-bit floats) or 32-bit floats ;; inexact reals can be flonums (64-bit floats) or 32-bit floats
(define -SingleFlonumNan (make-Base 'Single-Flonum-Nan (define -SingleFlonumNan (make-Base 'Single-Flonum-Nan
#'(and/c single-flonum? (lambda (x) (eqv? x +nan.f))) #'(and/c single-flonum? (lambda (x) (eqv? x +nan.f)))
@ -179,11 +179,11 @@
#'(lambda (x) (eqv? x -0.0f0)) #'(lambda (x) (eqv? x -0.0f0))
(lambda (x) (eqv? x -0.0f0)) (lambda (x) (eqv? x -0.0f0))
#'-SingleFlonumNegZero)) #'-SingleFlonumNegZero))
(define -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumNan)) (define/decl -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumNan))
(define -InexactRealNan (*Un -FlonumNan -SingleFlonumNan)) (define/decl -InexactRealNan (*Un -FlonumNan -SingleFlonumNan))
(define -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero)) (define/decl -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero))
(define -InexactRealNegZero (*Un -SingleFlonumNegZero -FlonumNegZero)) (define/decl -InexactRealNegZero (*Un -SingleFlonumNegZero -FlonumNegZero))
(define -InexactRealZero (*Un -InexactRealPosZero (define/decl -InexactRealZero (*Un -InexactRealPosZero
-InexactRealNegZero -InexactRealNegZero
-InexactRealNan)) -InexactRealNan))
(define -PosSingleFlonumNoNan (define -PosSingleFlonumNoNan
@ -191,29 +191,29 @@
#'(and/c single-flonum? positive?) #'(and/c single-flonum? positive?)
(lambda (x) (and (single-flonum? x) (positive? x))) (lambda (x) (and (single-flonum? x) (positive? x)))
#'-PosSingleFlonumNoNan)) #'-PosSingleFlonumNoNan))
(define -PosSingleFlonum (*Un -PosSingleFlonumNoNan -SingleFlonumNan)) (define/decl -PosSingleFlonum (*Un -PosSingleFlonumNoNan -SingleFlonumNan))
(define -PosInexactReal (*Un -PosSingleFlonum -PosFlonum)) (define/decl -PosInexactReal (*Un -PosSingleFlonum -PosFlonum))
(define -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumZero)) (define/decl -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumZero))
(define -NonNegInexactReal (*Un -PosInexactReal -InexactRealZero)) (define/decl -NonNegInexactReal (*Un -PosInexactReal -InexactRealZero))
(define -NegSingleFlonumNoNan (define/decl -NegSingleFlonumNoNan
(make-Base 'Negative-Single-Flonum-No-Nan (make-Base 'Negative-Single-Flonum-No-Nan
#'(and/c single-flonum? negative?) #'(and/c single-flonum? negative?)
(lambda (x) (and (single-flonum? x) (negative? x))) (lambda (x) (and (single-flonum? x) (negative? x)))
#'-NegSingleFlonumNoNan)) #'-NegSingleFlonumNoNan))
(define -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan)) (define/decl -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan))
(define -NegInexactReal (*Un -NegSingleFlonum -NegFlonum)) (define/decl -NegInexactReal (*Un -NegSingleFlonum -NegFlonum))
(define -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumZero)) (define/decl -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumZero))
(define -NonPosInexactReal (*Un -NegInexactReal -InexactRealZero)) (define/decl -NonPosInexactReal (*Un -NegInexactReal -InexactRealZero))
(define -SingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero -SingleFlonumPosZero -PosSingleFlonum -SingleFlonumNan)) (define/decl -SingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero -SingleFlonumPosZero -PosSingleFlonum -SingleFlonumNan))
(define -InexactReal (*Un -SingleFlonum -Flonum)) (define/decl -InexactReal (*Un -SingleFlonum -Flonum))
;; Reals ;; Reals
(define -RealZero (*Un -Zero -InexactRealZero)) (define/decl -RealZero (*Un -Zero -InexactRealZero))
(define -PosReal (*Un -PosRat -PosInexactReal)) (define/decl -PosReal (*Un -PosRat -PosInexactReal))
(define -NonNegReal (*Un -NonNegRat -NonNegInexactReal)) (define/decl -NonNegReal (*Un -NonNegRat -NonNegInexactReal))
(define -NegReal (*Un -NegRat -NegInexactReal)) (define/decl -NegReal (*Un -NegRat -NegInexactReal))
(define -NonPosReal (*Un -NonPosRat -NonPosInexactReal)) (define/decl -NonPosReal (*Un -NonPosRat -NonPosInexactReal))
(define -Real (*Un -Rat -InexactReal)) (define/decl -Real (*Un -Rat -InexactReal))
;; Complexes ;; Complexes
;; We could go into _much_ more precision here. ;; We could go into _much_ more precision here.
@ -296,9 +296,9 @@
(single-flonum? (imag-part x)) (single-flonum? (imag-part x))
(single-flonum? (real-part x)))) (single-flonum? (real-part x))))
#'-SingleFlonumComplex)) #'-SingleFlonumComplex))
(define -ExactNumber (*Un -ExactImaginary -ExactComplex -Rat)) (define/decl -ExactNumber (*Un -ExactImaginary -ExactComplex -Rat))
(define -InexactImaginary (*Un -FloatImaginary -SingleFlonumImaginary)) (define/decl -InexactImaginary (*Un -FloatImaginary -SingleFlonumImaginary))
(define -Imaginary (*Un -ExactImaginary -InexactImaginary)) (define/decl -Imaginary (*Un -ExactImaginary -InexactImaginary))
(define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex)) (define/decl -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
(define -Complex (*Un -Real -Imaginary -ExactComplex -InexactComplex)) (define/decl -Complex (*Un -Real -Imaginary -ExactComplex -InexactComplex))
(define -Number -Complex) (define -Number -Complex)