Merge branch 'main' into codex/split-epfn-into-two-functions

Author: obround

.gitignore

@@ -8,3 +8,4 @@ report/*
 rival-compiled
 *~
 test.rival
+.worktrees/

AGENTS.md

@@ -0,0 +1,12 @@
+
+# Organization
+
+- The MPFR bindings live in `mpfr.rkt`; the base interval definition
+  is in `ops/core.rkt`; the interval arithmetic functions are in
+  `ops/`; the real evaluator is in `eval/`; the REPL is in `repl.rkt`.
+  The tests are in `test.rkt`; the nightly is `time.rkt`. The nightly
+  also has various helper functions in `infra/`
+- Mandatory auto-format. Always run `make fmt` before finishing your
+  task to format your code correctly.
+- When editing an interval arithmetic function, always run the tests.
+  Run tests with `racket -y test.rkt add` (for the right function).

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)]
@@ -296,7 +297,7 @@
                  [n (in-naturals num-vars)])
       (fn->ival-fn node
                    (lambda ()
-                     (vector-set! registers n (new-ival))
+                     (vector-set! registers n (new-ival (*rival-max-precision*)))
                      n)
                    constants-lookup
                    (- n num-vars))))

eval/machine.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 
+(require "../mpfr.rkt")
 (provide (struct-out discretization)
          (struct-out rival-machine)
          *rival-max-precision*
@@ -12,7 +13,6 @@
          *base-tuning-precision*
          *bumps-activated*)
 
-(define *rival-max-precision* (make-parameter 10000))
 (define *rival-min-precision* (make-parameter 20))
 (define *rival-max-iterations* (make-parameter 5))
 (define *rival-profile-executions* (make-parameter 1000))

eval/main.rkt

@@ -83,7 +83,8 @@
   (rival-machine-load machine (vector-map ival-real pt))
   (let loop ([iter 0])
     (define-values (good? done? bad? stuck? fvec)
-      (parameterize ([*sampling-iteration* iter])
+      (parameterize ([*sampling-iteration* iter]
+                     [*rival-max-precision* (rival-machine-max-precision machine)])
         (rival-machine-full machine (or hint (rival-machine-default-hint machine)))))
     (cond
       [bad? (raise (exn:rival:invalid "Invalid input" (current-continuation-marks) pt))]

infra/run-baseline.rkt

@@ -23,6 +23,7 @@
                    registers
                    precisions
                    best-known-precisions
+                   max-precision
                    repeats
                    initial-repeats
                    default-hint
@@ -161,7 +162,7 @@
                  [n (in-naturals num-vars)])
       (fn->ival-fn node ; mappings are taken from Rival machine
                    (lambda ()
-                     (vector-set! registers n (new-ival))
+                     (vector-set! registers n (new-ival (*rival-max-precision*)))
                      n))))
 
   (define start-prec (+ (discretization-target (last discs)) 10))
@@ -182,6 +183,7 @@
                     registers
                     precisions
                     best-known-precisions
+                    (*rival-max-precision*)
                     repeats
                     initial-repeats
                     default-hint
@@ -201,6 +203,7 @@
 
 (define (baseline-apply machine pt [hint #f])
   (define discs (baseline-machine-discs machine))
+  (define max-precision (baseline-machine-max-precision machine))
   (define start-prec (+ (discretization-target (last discs)) 10))
   ; Load arguments
   (baseline-machine-load machine (vector-map ival-real pt))
@@ -214,7 +217,7 @@
       [bad? (raise (exn:rival:invalid "Invalid input" (current-continuation-marks) pt))]
       [done? fvec]
       [stuck? (raise (exn:rival:unsamplable "Unsamplable input" (current-continuation-marks) pt))]
-      [(> (* 2 prec) (*rival-max-precision*)) ; max precision is taken from eval/machine.rkt
+      [(> (* 2 prec) max-precision) ; max precision is taken from eval/machine.rkt
        (raise (exn:rival:unsamplable "Unsamplable input" (current-continuation-marks) pt))]
       [else (loop (* 2 prec) (+ iter 1))])))
 

main.rkt

@@ -138,8 +138,10 @@
 (module+ main
   (require "repl.rkt"
            racket/cmdline)
+  (define repl-mode repl-main)
   (command-line #:program "racket -l rival"
+                #:once-each [("--profile") "Print timing results" (set! repl-mode repl-profile)]
                 #:args ([file #f])
                 (if file
-                    (call-with-input-file file rival-repl)
-                    (rival-repl (current-input-port)))))
+                    (call-with-input-file file repl-mode)
+                    (repl-mode (current-input-port)))))

mpfr.rkt

@@ -3,6 +3,8 @@
 (require math/private/bigfloat/mpfr
          ffi/unsafe)
 
+(define *rival-max-precision* (make-parameter 10000))
+
 (provide -inf.bf
          -1.bf
          0.bf
@@ -13,7 +15,8 @@
          +inf.bf
          +nan.bf
          bf-return-exact?
-         rnd)
+         rnd
+         *rival-max-precision*)
 
 (define-syntax-rule (rnd mode op args ...)
   (parameterize ([bf-rounding-mode mode])
@@ -56,16 +59,86 @@
 (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-init2! (get-mpfr-fun 'mpfr_init2 (_fun _mpfr-pointer _prec_t -> _void)))
+(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)))
 
-(define (mpfr-new! prec)
-  (define bf (make-mpfr 0 0 0 #f))
-  (mpfr-init2! bf prec)
-  bf)
+(define mpfr-set-prec! set-mpfr-prec!)
 
 (define (bfremainder x mod)
   (define out (bf 0))
@@ -229,6 +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-new!
          mpfr-set!)

ops/all.rkt

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