Merge branch 'main' into pre-fabs

Author: obround

eval/compile.rkt

@@ -35,37 +35,37 @@
 
     [(list 'if c y f) (list ival-if c y f)]
 
-    [(list 'neg x) (list ival-neg x)]
-    [(list 'acos x) (list ival-acos x)]
-    [(list 'acosh x) (list ival-acosh x)]
-    [(list 'asin x) (list ival-asin x)]
-    [(list 'asinh x) (list ival-asinh x)]
-    [(list 'atan x) (list ival-atan x)]
-    [(list 'atanh x) (list ival-atanh x)]
-    [(list 'cbrt x) (list ival-cbrt x)]
+    [(list 'neg x) (list ival-neg! (alloc-outreg!) x)]
+    [(list 'acos x) (list ival-acos! (alloc-outreg!) x)]
+    [(list 'acosh x) (list ival-acosh! (alloc-outreg!) x)]
+    [(list 'asin x) (list ival-asin! (alloc-outreg!) x)]
+    [(list 'asinh x) (list ival-asinh! (alloc-outreg!) x)]
+    [(list 'atan x) (list ival-atan! (alloc-outreg!) x)]
+    [(list 'atanh x) (list ival-atanh! (alloc-outreg!) x)]
+    [(list 'cbrt x) (list ival-cbrt! (alloc-outreg!) x)]
     [(list 'ceil x) (list ival-ceil x)]
     [(list 'cos x) (list ival-cos x)]
-    [(list 'cosh x) (list ival-cosh x)]
-    [(list 'erf x) (list ival-erf x)]
-    [(list 'erfc x) (list ival-erfc x)]
-    [(list 'exp x) (list ival-exp x)]
-    [(list 'exp2 x) (list ival-exp2 x)]
-    [(list 'expm1 x) (list ival-expm1 x)]
+    [(list 'cosh x) (list ival-cosh! (alloc-outreg!) x)]
+    [(list 'erf x) (list ival-erf! (alloc-outreg!) x)]
+    [(list 'erfc x) (list ival-erfc! (alloc-outreg!) x)]
+    [(list 'exp x) (list ival-exp! (alloc-outreg!) x)]
+    [(list 'exp2 x) (list ival-exp2! (alloc-outreg!) x)]
+    [(list 'expm1 x) (list ival-expm1! (alloc-outreg!) x)]
     [(list 'fabs x) (list ival-fabs x)]
     [(list 'floor x) (list ival-floor x)]
     [(list 'lgamma x) (list ival-lgamma x)]
-    [(list 'log x) (list ival-log x)]
-    [(list 'log10 x) (list ival-log10 x)]
-    [(list 'log1p x) (list ival-log1p x)]
-    [(list 'log2 x) (list ival-log2 x)]
+    [(list 'log x) (list ival-log! (alloc-outreg!) x)]
+    [(list 'log10 x) (list ival-log10! (alloc-outreg!) x)]
+    [(list 'log1p x) (list ival-log1p! (alloc-outreg!) x)]
+    [(list 'log2 x) (list ival-log2! (alloc-outreg!) x)]
     [(list 'logb x) (list ival-logb x)]
-    [(list 'rint x) (list ival-rint x)]
+    [(list 'rint x) (list ival-rint! (alloc-outreg!) x)]
     [(list 'round x) (list ival-round x)]
     [(list 'sin x) (list ival-sin x)]
-    [(list 'sinh x) (list ival-sinh x)]
-    [(list 'sqrt x) (list ival-sqrt x)]
+    [(list 'sinh x) (list ival-sinh! (alloc-outreg!) x)]
+    [(list 'sqrt x) (list ival-sqrt! (alloc-outreg!) x)]
     [(list 'tan x) (list ival-tan x)]
-    [(list 'tanh x) (list ival-tanh x)]
+    [(list 'tanh x) (list ival-tanh! (alloc-outreg!) x)]
     [(list 'tgamma x) (list ival-tgamma x)]
     [(list 'trunc x) (list ival-trunc x)]
 

main.rkt

@@ -140,8 +140,7 @@
            racket/cmdline)
   (define repl-mode repl-main)
   (command-line #:program "racket -l rival"
-                #:once-each [("--profile") "Print timing results"
-                                           (set! repl-mode repl-profile)]
+                #:once-each [("--profile") "Print timing results" (set! repl-mode repl-profile)]
                 #:args ([file #f])
                 (if file
                     (call-with-input-file file repl-mode)

ops/all.rkt

@@ -22,23 +22,33 @@
          ival-sub
          ival-sub!
          ival-neg
+         ival-neg!
          ival-mult
          ival-mult!
          ival-div
          ival-div!
          ival-fma
          ival-fabs
          ival-sqrt
+         ival-sqrt!
          ival-cbrt
+         ival-cbrt!
          ival-hypot
          ival-hypot!
          ival-exp
+         ival-exp!
          ival-exp2
+         ival-exp2!
          ival-expm1
+         ival-expm1!
          ival-log
+         ival-log!
          ival-log2
+         ival-log2!
          ival-log10
+         ival-log10!
          ival-log1p
+         ival-log1p!
          ival-logb
          ival-pow
          ival-pow2
@@ -49,22 +59,34 @@
          ival-sinu
          ival-tanu
          ival-asin
+         ival-asin!
          ival-acos
+         ival-acos!
          ival-atan
+         ival-atan!
          ival-atan2
          ival-sinh
+         ival-sinh!
          ival-cosh
+         ival-cosh!
          ival-tanh
+         ival-tanh!
          ival-asinh
+         ival-asinh!
          ival-acosh
+         ival-acosh!
          ival-atanh
+         ival-atanh!
          ival-erf
+         ival-erf!
          ival-erfc
+         ival-erfc!
          ival-lgamma
          ival-tgamma
          ival-fmod
          ival-remainder
          ival-rint
+         ival-rint!
          ival-round
          ival-ceil
          ival-floor

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-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?
-        err))
+  (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))
 
 (define (ival-hypot x y)
   (ival-hypot! (new-ival (bf-precision)) x y))