Merge branch 'main' into codex/inline-epfn-for-boolean-functions

Author: pavpanchekha

ops/arith.rkt

@@ -16,33 +16,31 @@
          ival-hypot)
 
 ;; Endpoint computation for both `add`, `sub`, and `hypot` (which has an add inside)
-(define (eplinear bffn a-endpoint b-endpoint)
-  (match-define (endpoint a a!) a-endpoint)
-  (match-define (endpoint b b!) b-endpoint)
+(define (eplinear bffn a a! b b!)
   (define-values (val exact?) (bf-return-exact? bffn (list a b)))
-  (endpoint val (or (and a! b! exact?) (and a! (bfinfinite? a)) (and b! (bfinfinite? b)))))
+  (values val (or (and a! b! exact?) (and a! (bfinfinite? a)) (and b! (bfinfinite? b)))))
 
-(define (eplinear! out mpfr-fn! a-endpoint b-endpoint rnd)
-  (match-define (endpoint a a!) a-endpoint)
-  (match-define (endpoint b b!) b-endpoint)
+(define (eplinear! out mpfr-fn! a a! b b! rnd)
   (mpfr-set-prec! out (bf-precision))
   (define exact? (= 0 (mpfr-fn! out a b rnd)))
-  (endpoint out (or (and a! b! exact?) (and a! (bfinfinite? a)) (and b! (bfinfinite? b)))))
+  (values out (or (and a! b! exact?) (and a! (bfinfinite? a)) (and b! (bfinfinite? b)))))
 
 (define (ival-add! out x y)
-  (ival (eplinear! (ival-lo-val out) mpfr-add! (ival-lo x) (ival-lo y) 'down)
-        (eplinear! (ival-hi-val out) mpfr-add! (ival-hi x) (ival-hi y) 'up)
-        (or (ival-err? x) (ival-err? y))
-        (or (ival-err x) (ival-err y))))
+  (match-define (ival (endpoint xlo xlo!) (endpoint xhi xhi!) xerr? xerr) x)
+  (match-define (ival (endpoint ylo ylo!) (endpoint yhi yhi!) yerr? yerr) y)
+  (define-values (lo lo!) (eplinear! (ival-lo-val out) mpfr-add! xlo xlo! ylo ylo! 'down))
+  (define-values (hi hi!) (eplinear! (ival-hi-val out) mpfr-add! xhi xhi! yhi yhi! 'up))
+  (ival (endpoint lo lo!) (endpoint hi hi!) (or xerr? yerr?) (or xerr yerr)))
 
 (define (ival-add x y)
   (ival-add! (new-ival (bf-precision)) x y))
 
 (define (ival-sub! out x y)
-  (ival (eplinear! (ival-lo-val out) mpfr-sub! (ival-lo x) (ival-hi y) 'down)
-        (eplinear! (ival-hi-val out) mpfr-sub! (ival-hi x) (ival-lo y) 'up)
-        (or (ival-err? x) (ival-err? y))
-        (or (ival-err x) (ival-err y))))
+  (match-define (ival (endpoint xlo xlo!) (endpoint xhi xhi!) xerr? xerr) x)
+  (match-define (ival (endpoint ylo ylo!) (endpoint yhi yhi!) yerr? yerr) y)
+  (define-values (lo lo!) (eplinear! (ival-lo-val out) mpfr-sub! xlo xlo! yhi yhi! 'down))
+  (define-values (hi hi!) (eplinear! (ival-hi-val out) mpfr-sub! xhi xhi! ylo ylo! 'up))
+  (ival (endpoint lo lo!) (endpoint hi hi!) (or xerr? yerr?) (or xerr yerr)))
 
 (define (ival-sub x y)
   (ival-sub! (new-ival (bf-precision)) x y))
@@ -161,12 +159,11 @@
 (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 (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))
+  (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))
+  (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))
 
 (define (ival-hypot x y)
   (ival-hypot! (new-ival (bf-precision)) x y))

ops/pow.rkt

@@ -13,19 +13,17 @@
     [(and (< (mpfr-exp (ival-hi-val x)) 1) (not (bfinfinite? (ival-hi-val x)))) -1]
     [else 0]))
 
-(define (eppow a-endpoint b-endpoint a-class b-class)
-  (match-define (endpoint a a!) a-endpoint)
-  (match-define (endpoint b b!) b-endpoint)
+(define (eppow a a! b b! a-class b-class)
   (when (bfzero? a)
     (set! a 0.bf)) ; Handle (-0)^(-1)
   (define-values (val exact?) (bf-return-exact? bfexpt (list a b)))
-  (endpoint val
-            (or (and a! b! exact?)
-                (and a! (bf=? a 1.bf))
-                (and a! (bfzero? a) (not (= b-class 0)))
-                (and a! (bfinfinite? a) (not (= b-class 0)))
-                (and b! (bfzero? b))
-                (and b! (bfinfinite? b) (not (= a-class 0))))))
+  (values val
+          (or (and a! b! exact?)
+              (and a! (bf=? a 1.bf))
+              (and a! (bfzero? a) (not (= b-class 0)))
+              (and a! (bfinfinite? a) (not (= b-class 0)))
+              (and b! (bfzero? b))
+              (and b! (bfinfinite? b) (not (= a-class 0))))))
 
 (define (ival-copy-movability i1 i2)
   (ival (endpoint (ival-lo-val i1) (ival-lo-fixed? i2))
@@ -41,8 +39,24 @@
   (define y-class (classify-ival y))
 
   (define (mk-pow a b c d)
-    (match-define (endpoint lo lo!) (rnd 'down eppow a b x-class y-class))
-    (match-define (endpoint hi hi!) (rnd 'up eppow c d x-class y-class))
+    (define-values (lo lo!)
+      (rnd 'down
+           eppow
+           (endpoint-val a)
+           (endpoint-immovable? a)
+           (endpoint-val b)
+           (endpoint-immovable? b)
+           x-class
+           y-class))
+    (define-values (hi hi!)
+      (rnd 'up
+           eppow
+           (endpoint-val c)
+           (endpoint-immovable? c)
+           (endpoint-val d)
+           (endpoint-immovable? d)
+           x-class
+           y-class))
 
     (define-values (real-lo! real-hi!)
       (cond