fltester.rkt

#lang racket

(require math/bigfloat racket/flonum
         math/private/flonum/flonum-functions
         math/private/utils/flonum-tests
         math/private/flonum/flonum-bits
         math/private/flonum/flonum-constants)

(define-namespace-anchor ns)

(define fl-procs (list 'flabs
                 'flsqrt
                 'fllog
                 'flexp
                 'flsin
                 'flcos
                 'fltan
                 'flasin
                 'flacos
                 'flatan
                 'fllog2
                 'flexpt
                 ))

(define bf-procs (list 
            'bfabs
            'bfsqrt
            'bflog
            'bfexp
            'bfsin
            'bfcos
            'bftan
            'bfasin
            'bfacos
            'bfatan
            'bflog2
            'bfexpt))

(define table (for/hash ([b bf-procs] [f fl-procs]) (values f b)))

(current-namespace (namespace-anchor->namespace ns))

;; not provided so copied
(define (bigfloat->real* x)
  (define x.0 (bigfloat->flonum x))
  (cond [(fl= x.0 0.0)  x.0]
        [(flrational? x.0)  (bigfloat->real x)]
        [else  x.0]))

(define (check e #:precision [prec 128])
  (parameterize ([bf-precision prec])
    (match e
      [(list op args ...)
       (define e* (cons (hash-ref table op) (map bf args)))
       (define er (eval e))
       (define e*r (eval e*))
       (define e*s (~s e*))
       (printf "~a => ~a\n~a => ~a\n   error is ~s ulps with precision ~s\n"
               (~s e #:min-width (string-length e*s))
               (~r er #:precision 30 #:notation 'exponential)
               e*s
               (~r (bigfloat->real* e*r) #:precision 30 #:notation 'exponential)
               (flulp-error er (bigfloat->real* e*r))
               prec)])))




(check '(flexp 1.0))
(check '(flexp 1.0) #:precision 53)
(check '(flexp 1.0) #:precision 500)

(check '(flexpt 1.4916681462400412e-154 -1.0))

(check '(flexpt 1.4916681462400412e-154 -1.0) #:precision 53)
(check '(flexpt 1.4916681462400412e-154 -1.0) #:precision 500)


(check '(flsin 1.0508668734276366e+308))
(check '(flsin 1.0508668734276366e+308) #:precision 53)
(check '(flsin 1.0508668734276366e+308) #:precision 500)

(flulp-error -0.7849352660212705 (flsin 1.0508668734276366e+308))