Implement ival-pre-fabs for hypot and pow2

Author: obround

mpfr.rkt

@@ -85,6 +85,8 @@
 
 (define mpfr-abs! (get-mpfr-fun 'mpfr_abs (_fun _mpfr-pointer _mpfr-pointer _rnd_t -> _int)))
 
+(define mpfr-cmpabs (get-mpfr-fun 'mpfr_cmpabs (_fun _mpfr-pointer _mpfr-pointer -> _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)))
@@ -316,6 +318,7 @@
          mpfr-cbrt!
          mpfr-neg!
          mpfr-abs!
+         mpfr-cmpabs
          mpfr-asin!
          mpfr-acos!
          mpfr-atan!

ops/arith.rkt

@@ -161,8 +161,8 @@
 (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))
+  (define x* (ival-pre-fabs x))
+  (define y* (ival-pre-fabs 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?

ops/core.rkt

@@ -19,6 +19,7 @@
          ival-max-prec
          ival-exact-neg
          ival-exact-fabs
+         ival-pre-fabs
          bf-return-exact?
          ival-lo-fixed?
          ival-hi-fixed?
@@ -343,6 +344,19 @@
      (define abs-hi (epunary! tmp2 mpfr-abs! (ival-hi x) 'up))
      (ival (endpoint (bf 0) (and xlo! xhi!)) (endpoint-max2 abs-lo abs-hi 'up) xerr? xerr)]))
 
+(define (ival-pre-fabs x)
+  (match-define (ival xlo xhi xerr? xerr) x)
+  (define match-result
+    (match (classify-ival x)
+      [1 x]
+      [-1 (ival xhi xlo xerr? xerr)]
+      [0
+       (ival (endpoint 0.bf (and (endpoint-immovable? xlo) (endpoint-immovable? xhi)))
+             (if (= (mpfr-cmpabs (endpoint-val xlo) (endpoint-val xhi)) 1) xlo xhi)
+             xerr?
+             xerr)]))
+  match-result)
+
 ;; These functions execute ival-fabs and ival-neg with input's precision
 (define (ival-max-prec x)
   (max (bigfloat-precision (ival-lo-val x)) (bigfloat-precision (ival-hi-val x))))

ops/pow.rkt

@@ -139,7 +139,7 @@
         (ival-then (ival-assert ival-maybe) (ival-union (ival-neg pospow) pospow)))))
 
 (define (ival-pow2 x)
-  ((monotonic->ival (lambda (x) (bfmul x x))) (ival-exact-fabs x)))
+  ((monotonic->ival (lambda (x) (bfmul x x))) (ival-pre-fabs x)))
 
 (define (ival-pow x y)
   (cond