Merge pull request #130 from herbie-fp/direct-rounding-core-ops

Direct rounding for core operators

Author: pavpanchekha

eval/compile.rkt

@@ -73,6 +73,7 @@
     [(list '- x y) (list ival-sub! (alloc-outreg!) x y)]
     [(list '* x y) (list ival-mult! (alloc-outreg!) x y)]
     [(list '/ x y) (list ival-div! (alloc-outreg!) x y)]
+    [(list 'hypot x y) (list ival-hypot! (alloc-outreg!) x y)]
     #;[(list '+ x y) (list ival-add x y)]
     #;[(list '- x y) (list ival-sub x y)]
     #;[(list '* x y) (list ival-mult x y)]

mpfr.rkt

@@ -59,7 +59,82 @@
 (define mpfr-remainder!
   (get-mpfr-fun 'mpfr_remainder (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
 
-;(define mpfr-set-prec! (get-mpfr-fun 'mpfr_set_prec (_fun _mpfr-pointer _prec_t -> _void)))
+(define mpfr-hypot!
+  (get-mpfr-fun 'mpfr_hypot (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-pow!
+  (get-mpfr-fun 'mpfr_pow (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-log! (get-mpfr-fun 'mpfr_log (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-exp! (get-mpfr-fun 'mpfr_exp (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-expm1! (get-mpfr-fun 'mpfr_expm1 (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-sqrt! (get-mpfr-fun 'mpfr_sqrt (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-sin! (get-mpfr-fun 'mpfr_sin (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-cos! (get-mpfr-fun 'mpfr_cos (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-tan! (get-mpfr-fun 'mpfr_tan (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-cbrt! (get-mpfr-fun 'mpfr_cbrt (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-neg! (get-mpfr-fun 'mpfr_neg (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-abs! (get-mpfr-fun 'mpfr_abs (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-asin! (get-mpfr-fun 'mpfr_asin (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-acos! (get-mpfr-fun 'mpfr_acos (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-atan! (get-mpfr-fun 'mpfr_atan (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-sinh! (get-mpfr-fun 'mpfr_sinh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-tanh! (get-mpfr-fun 'mpfr_tanh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-asinh! (get-mpfr-fun 'mpfr_asinh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-acosh! (get-mpfr-fun 'mpfr_acosh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-atanh! (get-mpfr-fun 'mpfr_atanh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-erf! (get-mpfr-fun 'mpfr_erf (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-erfc! (get-mpfr-fun 'mpfr_erfc (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-log2! (get-mpfr-fun 'mpfr_log2 (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-log10! (get-mpfr-fun 'mpfr_log10 (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-log1p! (get-mpfr-fun 'mpfr_log1p (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-exp2! (get-mpfr-fun 'mpfr_exp2 (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-rint! (get-mpfr-fun 'mpfr_rint (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-round! (get-mpfr-fun 'mpfr_round (_fun _mpfr-pointer _mpfr-pointer -> _int)))
+
+(define mpfr-ceil! (get-mpfr-fun 'mpfr_ceil (_fun _mpfr-pointer _mpfr-pointer -> _int)))
+
+(define mpfr-floor! (get-mpfr-fun 'mpfr_floor (_fun _mpfr-pointer _mpfr-pointer -> _int)))
+
+(define mpfr-trunc! (get-mpfr-fun 'mpfr_trunc (_fun _mpfr-pointer _mpfr-pointer -> _int)))
+
+(define mpfr-min!
+  (get-mpfr-fun 'mpfr_min (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-max!
+  (get-mpfr-fun 'mpfr_max (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-cosh! (get-mpfr-fun 'mpfr_cosh (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-const-pi! (get-mpfr-fun 'mpfr_const_pi (_fun _mpfr-pointer _rnd_t -> _int)))
+
+(define mpfr-atan2!
+  (get-mpfr-fun 'mpfr_atan2 (_fun _mpfr-pointer _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
 
 (define mpfr-set! (get-mpfr-fun 'mpfr_set (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _void)))
 
@@ -227,5 +302,44 @@
          mpfr-sub!
          mpfr-mul!
          mpfr-div!
+         mpfr-hypot!
+         mpfr-pow!
+         mpfr-exp!
+         mpfr-expm1!
+         mpfr-sqrt!
+         mpfr-sin!
+         mpfr-cos!
+         mpfr-tan!
+         mpfr-cosu!
+         mpfr-sinu!
+         mpfr-tanu!
+         mpfr-cbrt!
+         mpfr-neg!
+         mpfr-abs!
+         mpfr-asin!
+         mpfr-acos!
+         mpfr-atan!
+         mpfr-sinh!
+         mpfr-cosh!
+         mpfr-tanh!
+         mpfr-asinh!
+         mpfr-acosh!
+         mpfr-atanh!
+         mpfr-erf!
+         mpfr-erfc!
+         mpfr-log2!
+         mpfr-log10!
+         mpfr-log1p!
+         mpfr-exp2!
+         mpfr-rint!
+         mpfr-round!
+         mpfr-ceil!
+         mpfr-floor!
+         mpfr-trunc!
+         mpfr-min!
+         mpfr-max!
+         mpfr-log!
+         mpfr-const-pi!
+         mpfr-atan2!
          mpfr-set-prec!
          mpfr-set!)

ops/all.rkt

@@ -31,6 +31,7 @@
          ival-sqrt
          ival-cbrt
          ival-hypot
+         ival-hypot!
          ival-exp
          ival-exp2
          ival-expm1

ops/arith.rkt

@@ -12,6 +12,7 @@
          ival-div
          ival-fma
          ival-fdim
+         ival-hypot!
          ival-hypot)
 
 ;; Endpoint computation for both `add`, `sub`, and `hypot` (which has an add inside)
@@ -46,7 +47,7 @@
 (define (ival-sub x y)
   (ival-sub! (new-ival (bf-precision)) x y))
 
-(define (epmul! out a-endpoint b-endpoint a-class b-class)
+(define (epmul! out a-endpoint b-endpoint a-class b-class rnd)
   (match-define (endpoint a a!) a-endpoint)
   (match-define (endpoint b b!) b-endpoint)
   (define a0 (bfzero? a))
@@ -57,7 +58,7 @@
       [(or a0 b0)
        (mpfr-set! out 0.bf 'nearest)
        #t]
-      [else (= 0 (mpfr-mul! out a b (bf-rounding-mode)))]))
+      [else (= 0 (mpfr-mul! out a b rnd))]))
   (endpoint out
             (or (and a! b! exact?)
                 (and a! a0)
@@ -77,8 +78,8 @@
 
   (define (mkmult out a b c d)
     (match-define (ival (endpoint rlo _) (endpoint rhi _) _ _) out)
-    (ival (rnd 'down epmul! rlo a b x-sign y-sign)
-          (rnd 'up epmul! rhi c d x-sign y-sign)
+    (ival (epmul! rlo a b x-sign y-sign 'down)
+          (epmul! rhi c d x-sign y-sign 'up)
           (or xerr? yerr?)
           (or xerr yerr)))
 
@@ -106,11 +107,11 @@
      (mpfr-set! (ival-hi-val out) hi 'up) ; should be exact
      (ival (endpoint (ival-lo-val out) lo!) (endpoint (ival-hi-val out) hi!) err? err)]))
 
-(define (epdiv! out a-endpoint b-endpoint a-class)
+(define (epdiv! out a-endpoint b-endpoint a-class rnd)
   (match-define (endpoint a a!) a-endpoint)
   (match-define (endpoint b b!) b-endpoint)
   (mpfr-set-prec! out (bf-precision))
-  (define exact? (= 0 (mpfr-div! out a b (bf-rounding-mode))))
+  (define exact? (= 0 (mpfr-div! out a b rnd)))
   (endpoint out
             (or (and a! b! exact?)
                 (and a! (bfzero? a))
@@ -128,7 +129,7 @@
   (define y-class (classify-ival-strict y))
 
   (define (mkdiv a b c d)
-    (ival (rnd 'down epdiv! rlo a b x-class) (rnd 'up epdiv! rhi c d x-class) err? err))
+    (ival (epdiv! rlo a b x-class 'down) (epdiv! rhi c d x-class 'up) err? err))
 
   (match* (x-class y-class)
     [(_ 0) ; In this case, y stradles 0
@@ -157,12 +158,15 @@
 (define (ival-fdim x y)
   (ival-fmax (ival-sub x y) (mk-ival 0.bf)))
 
-(define (ival-hypot x y)
+(define (ival-hypot! out x y)
   (define err? (or (ival-err? x) (ival-err? y)))
   (define err (or (ival-err x) (ival-err y)))
   (define x* (ival-exact-fabs x))
   (define y* (ival-exact-fabs y))
-  (ival (rnd 'down eplinear bfhypot (ival-lo x*) (ival-lo y*))
-        (rnd 'up eplinear bfhypot (ival-hi x*) (ival-hi y*))
+  (ival (eplinear! (ival-lo-val out) mpfr-hypot! (ival-lo x*) (ival-lo y*) 'down)
+        (eplinear! (ival-hi-val out) mpfr-hypot! (ival-hi x*) (ival-hi y*) 'up)
         err?
         err))
+
+(define (ival-hypot x y)
+  (ival-hypot! (new-ival (bf-precision)) x y))