On Monday, October 7, 2019 at 4:17:41 PM UTC-4, Marc Nieper-Wißkirchen wrote:
Hi,
does anyone know about an existing implementation of a procedure, say `real->binary64', that takes a Scheme real number `x' and returns a bytevector containing the binary64 representation (in any endianess) of an IEEE 754 double, which is closest to `x'
?
In particular, for a Scheme system whose inexact reals are implemented using IEEE doubles, this procedure should be a bijection (perhaps modulo NaNs).
Thanks for looking into it.
-- Marc
Here's some code from the Gambit compiler in vanilla Scheme.
Marc
;; The following procedures convert floating point numbers into their
;; ANSI-IEEE Std 754-1985 representation (32 bit and 64 bit floats).
;; They perform bignum and flonum arithmetic.
(define inexact-+2 (exact->inexact 2))
(define inexact--2 (exact->inexact -2))
(define inexact-+1 (exact->inexact 1))
(define inexact-+1/2 (exact->inexact (/ 1 2)))
(define inexact-+0 (exact->inexact 0))
(define (float->inexact-exponential-format x f64?)
(let* ((e-bits (if f64? 11 8))
(e-bias (- (expt 2 (- e-bits 1)) 1)))
(define (float-copysign x y)
(if (negative? y)
(- x)
x))
(define (exp-form-pos x y i)
(let ((i*2 (+ i i)))
(let ((z (if (and (not (< e-bias i*2))
(not (< x y)))
(exp-form-pos x (* y y) i*2)
(vector x 0 1))))
(let ((a (vector-ref z 0)) (b (vector-ref z 1)))
(let ((i+b (+ i b)))
(if (and (not (< e-bias i+b))
(not (< a y)))
(begin
(vector-set! z 0 (/ a y))
(vector-set! z 1 i+b)))
z)))))
(define (exp-form-neg x y i)
(let ((i*2 (+ i i)))
(let ((z (if (and (< i*2 (- e-bias 1))
(< x y))
(exp-form-neg x (* y y) i*2)
(vector x 0 1))))
(let ((a (vector-ref z 0)) (b (vector-ref z 1)))
(let ((i+b (+ i b)))
(if (and (< i+b (- e-bias 1))
(< a y))
(begin
(vector-set! z 0 (/ a y))
(vector-set! z 1 i+b)))
z)))))
(define (exp-form x)
(if (< x inexact-+1)
(let ((z (exp-form-neg x inexact-+1/2 1)))
(vector-set! z 0 (* inexact-+2 (vector-ref z 0)))
(vector-set! z 1 (- -1 (vector-ref z 1)))
z)
(exp-form-pos x inexact-+2 1)))
(if (negative? (float-copysign inexact-+1 x))
(let ((z (exp-form (float-copysign x inexact-+1))))
(vector-set! z 2 -1)
z)
(exp-form x))))
(define (float->exact-exponential-format x f64?)
(let* ((z (float->inexact-exponential-format x f64?))
(m-bits (if f64? 52 23))
(e-bits (if f64? 11 8)))
(let ((y (vector-ref z 0)))
(if (not (< y inexact-+2)) ;; +inf.0 or +nan.0?
(begin
(if (< inexact-+0 y)
(vector-set! z 0 (expt 2 m-bits)) ;; +inf.0
(vector-set! z 0 (- (* (expt 2 m-bits) 2) 1))) ;; +nan.0
(vector-set! z 1 (expt 2 (- e-bits 1))))
(vector-set! z 0
(truncate
(inexact->exact
(* (vector-ref z 0)
(exact->inexact (expt 2 m-bits)))))))
(vector-set! z 1 (- (vector-ref z 1) m-bits))
z)))
(define (float->bits x f64?)
(let ((m-bits (if f64? 52 23))
(e-bits (if f64? 11 8)))
(define (bits a b)
(let ((m-min (expt 2 m-bits)))
(if (< a m-min)
a
(+ (- a m-min)
(* (+ (+ b m-bits) (- (expt 2 (- e-bits 1)) 1))
m-min)))))
(let* ((z (float->exact-exponential-format x f64?))
(y (bits (vector-ref z 0) (vector-ref z 1))))
(if (negative? (vector-ref z 2))
(+ (expt 2 (+ e-bits m-bits)) y)
y))))
(println (number->string (float->bits 1.5 #t) 16)) ;; 3ff8000000000000
(println (number->string (float->bits 1.5 #f) 16)) ;; 3fc00000
--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)