Remove dependency on unstable/flonum.

This commit is contained in:
Vincent St-Amour 2015-08-27 14:24:05 -05:00
parent 29784bda8e
commit 4eeb164d31

View File

@ -2,7 +2,52 @@
(Section 'math)
(require scheme/math
racket/flonum
unstable/flonum)
racket/unsafe/ops)
(define (flonum->bit-field x)
(cond [(flonum? x) (integer-bytes->integer (real->floating-point-bytes x 8) #f)]
[else (raise-type-error 'flonum->bit-field "flonum" x)]))
(define (bit-field->flonum i)
(cond [(and (exact-integer? i) (i . >= . 0) (i . <= . #xffffffffffffffff))
(floating-point-bytes->real (integer->integer-bytes i 8 #f))]
[else
(raise-type-error 'bit-field->flonum "exact integer in [0,#xffffffffffffffff]" i)]))
(define (flonum->ordinal x)
(cond [(flonum? x) (cond [(x . < . 0) (- (flonum->bit-field (- x)))]
[else (flonum->bit-field (unsafe-flabs x))])] ; abs for -0.0
[else (raise-type-error 'flonum->ordinal "flonum" x)]))
(define (ordinal->flonum i)
(cond [(and (exact-integer? i) (i . >= . #x-7fffffffffffffff) (i . <= . #x7fffffffffffffff))
(cond [(i . < . 0) (- (bit-field->flonum (- i)))]
[else (bit-field->flonum i)])]
[else
(raise-type-error
'ordinal->flonum "exact integer in [#x-7fffffffffffffff,#xffffffffffffffff]" i)]))
(define +inf-ordinal (flonum->ordinal +inf.0))
(define -inf-ordinal (flonum->ordinal -inf.0))
(define (flstep x n)
(cond [(not (flonum? x)) (raise-type-error 'flstep "flonum" 0 x n)]
[(not (exact-integer? n)) (raise-type-error 'flstep "exact integer" 1 x n)]
[(eqv? x +nan.0) +nan.0]
[(and (eqv? x +inf.0) (n . >= . 0)) +inf.0]
[(and (eqv? x -inf.0) (n . <= . 0)) -inf.0]
[else (define i (+ n (flonum->ordinal x)))
(cond [(i . < . -inf-ordinal) -inf.0]
[(i . > . +inf-ordinal) +inf.0]
[else (ordinal->flonum i)])]))
(define (flnext x) (flstep x 1))
(define (flprev x) (flstep x -1))
(define -max.0 (flnext -inf.0))
(define -min.0 (flprev 0.0))
(define +min.0 (flnext 0.0))
(define +max.0 (flprev +inf.0))
(define (double=? x y)
(and (flonum? y)