Merge pull request #136 from herbie-fp/pre-fabs

Implement `ival-pre-fabs`

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)))
@@ -318,6 +320,7 @@
          mpfr-cbrt!
          mpfr-neg!
          mpfr-abs!
+         mpfr-cmpabs
          mpfr-asin!
          mpfr-acos!
          mpfr-atan!

ops/arith.rkt

@@ -159,8 +159,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)))
-  (match-define (ival (endpoint xlo xlo!) (endpoint xhi xhi!) _ _) (ival-exact-fabs x))
-  (match-define (ival (endpoint ylo ylo!) (endpoint yhi yhi!) _ _) (ival-exact-fabs y))
+  (match-define (ival (endpoint xlo xlo!) (endpoint xhi xhi!) _ _) (ival-pre-fabs x))
+  (match-define (ival (endpoint ylo ylo!) (endpoint yhi yhi!) _ _) (ival-pre-fabs y))
   (define-values (lo lo!) (eplinear! (ival-lo-val out) mpfr-hypot! xlo xlo! ylo ylo! 'down))
   (define-values (hi hi!) (eplinear! (ival-hi-val out) mpfr-hypot! xhi xhi! yhi yhi! 'up))
   (ival (endpoint lo lo!) (endpoint hi hi!) err? 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?
@@ -385,6 +386,17 @@
      (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)
+  (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)) 0) xlo xhi)
+           xerr?
+           xerr)]))
+
 ;; 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

@@ -153,7 +153,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