Remember types that are defined, and use them in serialization.
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
parent
23814ec5b3
commit
56b372ca4d
|
|
@ -48,6 +48,7 @@
|
|||
(define (gen-constructor sym)
|
||||
(string->symbol (string-append "make-" (substring (symbol->string sym) 7))))
|
||||
(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))]
|
||||
[(Base: n cnt pred marshaled _) marshaled]
|
||||
[(Name: stx) `(make-Name (quote-syntax ,stx))]
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
(syntax-parse stx
|
||||
[(def-export export-id:identifier id:identifier cnt-id:identifier)
|
||||
#'(define-syntax export-id
|
||||
(if (unbox typed-context?)
|
||||
(renamer #'id #'cnt-id)
|
||||
(renamer #'cnt-id)))]))
|
||||
(let ([c #'cnt-id])
|
||||
(if (unbox typed-context?)
|
||||
(renamer #'id c)
|
||||
(renamer c))))]))
|
||||
|
|
|
|||
|
|
@ -380,21 +380,22 @@
|
|||
#`(begin
|
||||
(begin-for-syntax
|
||||
(module* #%type-decl #f
|
||||
(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/types/type-table)
|
||||
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
||||
#,(talias-env-init-code)
|
||||
#,(tname-env-init-code)
|
||||
#,(tvariance-env-init-code)
|
||||
#,(mvar-env-init-code mvar-env)
|
||||
#,(make-struct-table-code)
|
||||
#,@(for/list ([a (in-list aliases)])
|
||||
(match a
|
||||
[(list from to)
|
||||
#`(add-alias (quote-syntax #,from) (quote-syntax #,to))]))))
|
||||
(begin-for-syntax (add-mod! (variable-reference->module-path-index
|
||||
(#%variable-reference)))))
|
||||
(#%plain-module-begin ;; avoid top-level printing and config
|
||||
(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/types/type-table typed-racket/types/abbrev)
|
||||
#,(env-init-code syntax-provide? provide-tbl def-tbl)
|
||||
#,(talias-env-init-code)
|
||||
#,(tname-env-init-code)
|
||||
#,(tvariance-env-init-code)
|
||||
#,(mvar-env-init-code mvar-env)
|
||||
#,(make-struct-table-code)
|
||||
#,@(for/list ([a (in-list aliases)])
|
||||
(match a
|
||||
[(list from to)
|
||||
#`(add-alias (quote-syntax #,from) (quote-syntax #,to))])))))
|
||||
(begin-for-syntax (add-mod! (variable-reference->module-path-index
|
||||
(#%variable-reference)))))
|
||||
#`(begin
|
||||
#,(if (null? (syntax-e #'(new-provs ...)))
|
||||
#'(begin)
|
||||
|
|
|
|||
|
|
@ -83,7 +83,7 @@
|
|||
|
||||
(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
|
||||
(make-Base 'Undefined
|
||||
#'(lambda (x) (equal? (letrec ([y y]) y) x)) ; initial value of letrec bindings
|
||||
|
|
@ -101,14 +101,14 @@
|
|||
#'-PRegexp))
|
||||
(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?))
|
||||
(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-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 -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 'lib) -String)
|
||||
(-lst* (-val 'file) -String)
|
||||
|
|
@ -135,7 +135,7 @@
|
|||
#'(and/c compiled-expression? (not/c compiled-module-expression?))
|
||||
(conjoin compiled-expression? (negate compiled-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 -Path (make-Base 'Path #'path? path? #'-Path))
|
||||
(define -OtherSystemPath (make-Base 'OtherSystemPath
|
||||
|
|
@ -170,7 +170,7 @@
|
|||
(make-Box sexp)
|
||||
t)))
|
||||
|
||||
(define -Sexp (-Sexpof (Un)))
|
||||
(define/decl -Sexp (-Sexpof (Un)))
|
||||
|
||||
(define Syntax-Sexp (-Sexpof Any-Syntax))
|
||||
|
||||
|
|
@ -185,14 +185,14 @@
|
|||
(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 -Pathlike (Un -String -Path))
|
||||
(define -SomeSystemPathlike (Un -String -SomeSystemPath))
|
||||
(define -Pathlike* (Un -String -Path (-val 'up) (-val 'same)))
|
||||
(define -SomeSystemPathlike* (Un -String -SomeSystemPath(-val 'up) (-val 'same)))
|
||||
(define -PathConventionType (Un (-val 'unix) (-val 'windows)))
|
||||
(define/decl -SomeSystemPath (Un -Path -OtherSystemPath))
|
||||
(define/decl -Pathlike (Un -String -Path))
|
||||
(define/decl -SomeSystemPathlike (Un -String -SomeSystemPath))
|
||||
(define/decl -Pathlike* (Un -String -Path (-val 'up) (-val 'same)))
|
||||
(define/decl -SomeSystemPathlike* (Un -String -SomeSystemPath(-val 'up) (-val 'same)))
|
||||
(define/decl -PathConventionType (Un (-val 'unix) (-val 'windows)))
|
||||
|
||||
|
||||
|
||||
|
|
@ -244,7 +244,7 @@
|
|||
|
||||
(define -Logger (make-Base 'Logger #'logger? logger? #'-Logger))
|
||||
(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
|
||||
|
|
@ -252,7 +252,7 @@
|
|||
(define -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
|
||||
(make-Base 'Will-Executor #'will-executor? will-executor? #'-Will-Executor))
|
||||
|
|
@ -297,8 +297,8 @@
|
|||
[(t)
|
||||
(make-pred-ty (list Univ) -Boolean t 0 null)]))
|
||||
|
||||
(define -true-filter (-FS -top -bot))
|
||||
(define -false-filter (-FS -bot -top))
|
||||
(define/decl -true-filter (-FS -top -bot))
|
||||
(define/decl -false-filter (-FS -bot -top))
|
||||
|
||||
(define (opt-fn args opt-args result)
|
||||
(apply cl->* (for/list ([i (in-range (add1 (length opt-args)))])
|
||||
|
|
|
|||
|
|
@ -13,9 +13,17 @@
|
|||
(rename-out [make-Listof -lst]
|
||||
[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
|
||||
(define Univ (make-Univ))
|
||||
(define -Bottom (make-Union null))
|
||||
(define/decl Univ (make-Univ))
|
||||
(define/decl -Bottom (make-Union null))
|
||||
(define Err (make-Error))
|
||||
|
||||
;A Type that corresponds to the any contract for the
|
||||
|
|
|
|||
|
|
@ -50,16 +50,16 @@
|
|||
(>= n 0)))
|
||||
|
||||
;; Singletons
|
||||
(define -Zero (make-Value 0)) ; exact
|
||||
(define -One (make-Value 1))
|
||||
(define/decl -Zero (make-Value 0)) ; exact
|
||||
(define/decl -One (make-Value 1))
|
||||
|
||||
;; Integers
|
||||
(define -Byte>1 (make-Base 'Byte-Larger-Than-One ; unsigned
|
||||
#'(and/c byte? (lambda (x) (> x 1)))
|
||||
(conjoin byte? (lambda (x) (> x 1)))
|
||||
#'-Byte>1))
|
||||
(define -PosByte (*Un -One -Byte>1))
|
||||
(define -Byte (*Un -Zero -PosByte))
|
||||
(define/decl -PosByte (*Un -One -Byte>1))
|
||||
(define/decl -Byte (*Un -Zero -PosByte))
|
||||
(define -PosIndexNotByte
|
||||
(make-Base 'Positive-Index-Not-Byte
|
||||
;; index? will be checked at runtime, can be platform-specific
|
||||
|
|
@ -69,8 +69,8 @@
|
|||
(positive? x)
|
||||
(not (byte? x))))
|
||||
#'-PosIndexNotByte))
|
||||
(define -PosIndex (*Un -One -Byte>1 -PosIndexNotByte))
|
||||
(define -Index (*Un -Zero -PosIndex))
|
||||
(define/decl -PosIndex (*Un -One -Byte>1 -PosIndexNotByte))
|
||||
(define/decl -Index (*Un -Zero -PosIndex))
|
||||
(define -PosFixnumNotIndex
|
||||
(make-Base 'Positive-Fixnum-Not-Index
|
||||
#'(and/c fixnum? positive? (not/c index?))
|
||||
|
|
@ -78,16 +78,16 @@
|
|||
(positive? x)
|
||||
(not (portable-index? x))))
|
||||
#'-PosFixnumNotIndex))
|
||||
(define -PosFixnum (*Un -PosFixnumNotIndex -PosIndex))
|
||||
(define -NonNegFixnum (*Un -PosFixnum -Zero))
|
||||
(define/decl -PosFixnum (*Un -PosFixnumNotIndex -PosIndex))
|
||||
(define/decl -NonNegFixnum (*Un -PosFixnum -Zero))
|
||||
(define -NegFixnum
|
||||
(make-Base 'Negative-Fixnum
|
||||
#'(and/c fixnum? negative?)
|
||||
(lambda (x) (and (portable-fixnum? x)
|
||||
(negative? x)))
|
||||
#'-NegFixnum))
|
||||
(define -NonPosFixnum (*Un -NegFixnum -Zero))
|
||||
(define -Fixnum (*Un -NegFixnum -Zero -PosFixnum))
|
||||
(define/decl -NonPosFixnum (*Un -NegFixnum -Zero))
|
||||
(define/decl -Fixnum (*Un -NegFixnum -Zero -PosFixnum))
|
||||
;; This type, and others like it, should *not* be exported, or used for
|
||||
;; anything but building unions. Especially, no literals should be given
|
||||
;; these types.
|
||||
|
|
@ -98,9 +98,9 @@
|
|||
(positive? x)
|
||||
(not (portable-fixnum? x))))
|
||||
#'-PosIntNotFixnum))
|
||||
(define -PosInt (*Un -PosIntNotFixnum -PosFixnum))
|
||||
(define -NonNegInt (*Un -PosInt -Zero))
|
||||
(define -Nat -NonNegInt)
|
||||
(define/decl -PosInt (*Un -PosIntNotFixnum -PosFixnum))
|
||||
(define/decl -NonNegInt (*Un -PosInt -Zero))
|
||||
(define/decl -Nat -NonNegInt)
|
||||
(define -NegIntNotFixnum
|
||||
(make-Base 'Negative-Integer-Not-Fixnum
|
||||
#'(and/c exact-integer? negative? (not/c fixnum?))
|
||||
|
|
@ -108,9 +108,9 @@
|
|||
(negative? x)
|
||||
(not (portable-fixnum? x))))
|
||||
#'-NegIntNotFixnum))
|
||||
(define -NegInt (*Un -NegIntNotFixnum -NegFixnum))
|
||||
(define -NonPosInt (*Un -NegInt -Zero))
|
||||
(define -Int (*Un -NegInt -Zero -PosInt))
|
||||
(define/decl -NegInt (*Un -NegIntNotFixnum -NegFixnum))
|
||||
(define/decl -NonPosInt (*Un -NegInt -Zero))
|
||||
(define/decl -Int (*Un -NegInt -Zero -PosInt))
|
||||
|
||||
;; Rationals
|
||||
(define -PosRatNotInt
|
||||
|
|
@ -120,8 +120,8 @@
|
|||
(positive? x)
|
||||
(not (exact-integer? x))))
|
||||
#'-PosRatNotInt))
|
||||
(define -PosRat (*Un -PosRatNotInt -PosInt))
|
||||
(define -NonNegRat (*Un -PosRat -Zero))
|
||||
(define/decl -PosRat (*Un -PosRatNotInt -PosInt))
|
||||
(define/decl -NonNegRat (*Un -PosRat -Zero))
|
||||
(define -NegRatNotInt
|
||||
(make-Base 'Negative-Rational-Not-Integer
|
||||
#'(and/c exact-rational? negative? (not/c integer?))
|
||||
|
|
@ -129,9 +129,9 @@
|
|||
(negative? x)
|
||||
(not (exact-integer? x))))
|
||||
#'-NegRatNotInt))
|
||||
(define -NegRat (*Un -NegRatNotInt -NegInt))
|
||||
(define -NonPosRat (*Un -NegRat -Zero))
|
||||
(define -Rat (*Un -NegRat -Zero -PosRat))
|
||||
(define/decl -NegRat (*Un -NegRatNotInt -NegInt))
|
||||
(define/decl -NonPosRat (*Un -NegRat -Zero))
|
||||
(define/decl -Rat (*Un -NegRat -Zero -PosRat))
|
||||
|
||||
;; Floating-point numbers
|
||||
;; NaN is included in all floating-point types
|
||||
|
|
@ -147,22 +147,22 @@
|
|||
#'(lambda (x) (eqv? x -0.0))
|
||||
(lambda (x) (eqv? x -0.0))
|
||||
#'-FlonumNegZero))
|
||||
(define -FlonumZero (*Un -FlonumPosZero -FlonumNegZero -FlonumNan))
|
||||
(define/decl -FlonumZero (*Un -FlonumPosZero -FlonumNegZero -FlonumNan))
|
||||
(define -PosFlonumNoNan
|
||||
(make-Base 'Positive-Float-No-NaN
|
||||
#'(and/c flonum? positive?)
|
||||
(lambda (x) (and (flonum? x) (positive? x)))
|
||||
#'-PosFlonumNoNan))
|
||||
(define -PosFlonum (*Un -PosFlonumNoNan -FlonumNan))
|
||||
(define -NonNegFlonum (*Un -PosFlonum -FlonumZero))
|
||||
(define/decl -PosFlonum (*Un -PosFlonumNoNan -FlonumNan))
|
||||
(define/decl -NonNegFlonum (*Un -PosFlonum -FlonumZero))
|
||||
(define -NegFlonumNoNan
|
||||
(make-Base 'Negative-Float-No-NaN
|
||||
#'(and/c flonum? negative?)
|
||||
(lambda (x) (and (flonum? x) (negative? x)))
|
||||
#'-NegFlonumNoNan))
|
||||
(define -NegFlonum (*Un -NegFlonumNoNan -FlonumNan))
|
||||
(define -NonPosFlonum (*Un -NegFlonum -FlonumZero))
|
||||
(define -Flonum (*Un -NegFlonumNoNan -FlonumNegZero -FlonumPosZero -PosFlonumNoNan -FlonumNan)) ; 64-bit floats
|
||||
(define/decl -NegFlonum (*Un -NegFlonumNoNan -FlonumNan))
|
||||
(define/decl -NonPosFlonum (*Un -NegFlonum -FlonumZero))
|
||||
(define/decl -Flonum (*Un -NegFlonumNoNan -FlonumNegZero -FlonumPosZero -PosFlonumNoNan -FlonumNan)) ; 64-bit floats
|
||||
;; inexact reals can be flonums (64-bit floats) or 32-bit floats
|
||||
(define -SingleFlonumNan (make-Base 'Single-Flonum-Nan
|
||||
#'(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))
|
||||
#'-SingleFlonumNegZero))
|
||||
(define -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumNan))
|
||||
(define -InexactRealNan (*Un -FlonumNan -SingleFlonumNan))
|
||||
(define -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero))
|
||||
(define -InexactRealNegZero (*Un -SingleFlonumNegZero -FlonumNegZero))
|
||||
(define -InexactRealZero (*Un -InexactRealPosZero
|
||||
(define/decl -SingleFlonumZero (*Un -SingleFlonumPosZero -SingleFlonumNegZero -SingleFlonumNan))
|
||||
(define/decl -InexactRealNan (*Un -FlonumNan -SingleFlonumNan))
|
||||
(define/decl -InexactRealPosZero (*Un -SingleFlonumPosZero -FlonumPosZero))
|
||||
(define/decl -InexactRealNegZero (*Un -SingleFlonumNegZero -FlonumNegZero))
|
||||
(define/decl -InexactRealZero (*Un -InexactRealPosZero
|
||||
-InexactRealNegZero
|
||||
-InexactRealNan))
|
||||
(define -PosSingleFlonumNoNan
|
||||
|
|
@ -191,29 +191,29 @@
|
|||
#'(and/c single-flonum? positive?)
|
||||
(lambda (x) (and (single-flonum? x) (positive? x)))
|
||||
#'-PosSingleFlonumNoNan))
|
||||
(define -PosSingleFlonum (*Un -PosSingleFlonumNoNan -SingleFlonumNan))
|
||||
(define -PosInexactReal (*Un -PosSingleFlonum -PosFlonum))
|
||||
(define -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumZero))
|
||||
(define -NonNegInexactReal (*Un -PosInexactReal -InexactRealZero))
|
||||
(define -NegSingleFlonumNoNan
|
||||
(define/decl -PosSingleFlonum (*Un -PosSingleFlonumNoNan -SingleFlonumNan))
|
||||
(define/decl -PosInexactReal (*Un -PosSingleFlonum -PosFlonum))
|
||||
(define/decl -NonNegSingleFlonum (*Un -PosSingleFlonum -SingleFlonumZero))
|
||||
(define/decl -NonNegInexactReal (*Un -PosInexactReal -InexactRealZero))
|
||||
(define/decl -NegSingleFlonumNoNan
|
||||
(make-Base 'Negative-Single-Flonum-No-Nan
|
||||
#'(and/c single-flonum? negative?)
|
||||
(lambda (x) (and (single-flonum? x) (negative? x)))
|
||||
#'-NegSingleFlonumNoNan))
|
||||
(define -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan))
|
||||
(define -NegInexactReal (*Un -NegSingleFlonum -NegFlonum))
|
||||
(define -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumZero))
|
||||
(define -NonPosInexactReal (*Un -NegInexactReal -InexactRealZero))
|
||||
(define -SingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero -SingleFlonumPosZero -PosSingleFlonum -SingleFlonumNan))
|
||||
(define -InexactReal (*Un -SingleFlonum -Flonum))
|
||||
(define/decl -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan))
|
||||
(define/decl -NegInexactReal (*Un -NegSingleFlonum -NegFlonum))
|
||||
(define/decl -NonPosSingleFlonum (*Un -NegSingleFlonum -SingleFlonumZero))
|
||||
(define/decl -NonPosInexactReal (*Un -NegInexactReal -InexactRealZero))
|
||||
(define/decl -SingleFlonum (*Un -NegSingleFlonum -SingleFlonumNegZero -SingleFlonumPosZero -PosSingleFlonum -SingleFlonumNan))
|
||||
(define/decl -InexactReal (*Un -SingleFlonum -Flonum))
|
||||
|
||||
;; Reals
|
||||
(define -RealZero (*Un -Zero -InexactRealZero))
|
||||
(define -PosReal (*Un -PosRat -PosInexactReal))
|
||||
(define -NonNegReal (*Un -NonNegRat -NonNegInexactReal))
|
||||
(define -NegReal (*Un -NegRat -NegInexactReal))
|
||||
(define -NonPosReal (*Un -NonPosRat -NonPosInexactReal))
|
||||
(define -Real (*Un -Rat -InexactReal))
|
||||
(define/decl -RealZero (*Un -Zero -InexactRealZero))
|
||||
(define/decl -PosReal (*Un -PosRat -PosInexactReal))
|
||||
(define/decl -NonNegReal (*Un -NonNegRat -NonNegInexactReal))
|
||||
(define/decl -NegReal (*Un -NegRat -NegInexactReal))
|
||||
(define/decl -NonPosReal (*Un -NonPosRat -NonPosInexactReal))
|
||||
(define/decl -Real (*Un -Rat -InexactReal))
|
||||
|
||||
;; Complexes
|
||||
;; We could go into _much_ more precision here.
|
||||
|
|
@ -296,9 +296,9 @@
|
|||
(single-flonum? (imag-part x))
|
||||
(single-flonum? (real-part x))))
|
||||
#'-SingleFlonumComplex))
|
||||
(define -ExactNumber (*Un -ExactImaginary -ExactComplex -Rat))
|
||||
(define -InexactImaginary (*Un -FloatImaginary -SingleFlonumImaginary))
|
||||
(define -Imaginary (*Un -ExactImaginary -InexactImaginary))
|
||||
(define -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
|
||||
(define -Complex (*Un -Real -Imaginary -ExactComplex -InexactComplex))
|
||||
(define/decl -ExactNumber (*Un -ExactImaginary -ExactComplex -Rat))
|
||||
(define/decl -InexactImaginary (*Un -FloatImaginary -SingleFlonumImaginary))
|
||||
(define/decl -Imaginary (*Un -ExactImaginary -InexactImaginary))
|
||||
(define/decl -InexactComplex (*Un -FloatComplex -SingleFlonumComplex))
|
||||
(define/decl -Complex (*Un -Real -Imaginary -ExactComplex -InexactComplex))
|
||||
(define -Number -Complex)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user