quite extreme optimizations

AYadrov · AYadrov · commit 0137ff07d72f · 2025-04-09T15:59:08.000-06:00
diff --git a/eval/adjust.rkt b/eval/adjust.rkt
@@ -239,18 +239,17 @@
   (define vprecs-min (make-vector (vector-length ivec) 0))
 
   (define slack (get-slack))
-  (define vlogs (vector-map (curryr minlog+maxlog+logspan slack) vregs))
+  (define vinfo (vector-map (curryr ival+minlog+maxlog+logspan slack) vregs))
 
   (for ([instr (in-vector ivec (- (vector-length ivec) 1) -1 -1)]
         [repeat? (in-vector vrepeats (- (vector-length vrepeats) 1) -1 -1)]
         [n (in-range (- (vector-length vregs) 1) -1 -1)]
         [hint (in-vector vhint (- (vector-length vhint) 1) -1 -1)]
-        [output (in-vector vregs (- (vector-length vregs) 1) -1 -1)]
-        [logs (in-vector vlogs (- (vector-length vlogs) 1) -1 -1)]
+        [output (in-vector vinfo (- (vector-length vinfo) 1) -1 -1)]
         #:when (and hint (not repeat?)))
     (define op (car instr))
     (define tail-registers (drop-self-pointer (cdr instr) n))
-    (define srcs (map (lambda (x) (cons (vector-ref vregs x) (vector-ref vlogs x))) tail-registers))
+    (define srcs (map (lambda (x) (vector-ref vinfo x)) tail-registers))
 
     (define max-prec (vector-ref vprecs-max (- n varc))) ; upper precision bound given from parent
     (define min-prec (vector-ref vprecs-min (- n varc))) ; lower precision bound given from parent
@@ -271,8 +270,7 @@
          (*sampling-iteration* (*rival-max-iterations*)))])
 
     ; Precision propogation for each tail instruction
-    (define ampl-bounds
-      (get-bounds op (cons output logs) srcs)) ; amplification bounds for children instructions
+    (define ampl-bounds (get-bounds op output srcs)) ; amplification bounds for children instructions
     (for ([x (in-list tail-registers)]
           [bound (in-list ampl-bounds)]
           #:when (>= x varc)) ; when tail register is not a variable
diff --git a/eval/tricks.rkt b/eval/tricks.rkt
@@ -10,7 +10,7 @@
 
 (provide get-bounds
          get-slack
-         minlog+maxlog+logspan)
+         ival+minlog+maxlog+logspan)
 
 (define (get-slack [iter (*sampling-iteration*)])
   (match iter
@@ -70,52 +70,52 @@
        [else (min (mpfr-exp lo) (mpfr-exp hi))])]))
 
 ; Returns (list (minlog x) (maxlog x) (logspan x))
-(define (minlog+maxlog+logspan x slack)
+(define (ival+minlog+maxlog+logspan x slack)
   (define lo (ival-lo x))
   (define hi (ival-hi x))
   (match (and (boolean? lo) (boolean? hi))
-    [#t (list 0 0 0)]
+    [#t (list x 0 0 0)]
     [#f
      (define lo-exp (mpfr-exp lo))
      (define hi-exp (mpfr-exp hi))
-     (define logspan
+     ; logspan
+     (define lg
        (match (*bumps-activated*)
          [#t
           (if (or (bfzero? lo) (bfinfinite? lo) (bfzero? hi) (bfinfinite? hi))
               slack
               (+ (abs (- lo-exp hi-exp)) 1))]
          [#f 0]))
-
-     (cond
-       ; x = [0.bf, 0.bf]
-       [(and (bfzero? lo) (bfzero? hi)) (list (- slack) (- slack) logspan)]
-       [(bfzero? lo)
-        (if (bfinfinite? hi)
-            (list (- slack) slack logspan) ; x = [0.bf, +inf]
-            (list (- (min hi-exp 0) slack) (+ hi-exp 1) logspan))] ; x = [0.bf, +...]
-       [(bfzero? hi)
-        (if (bfinfinite? lo)
-            (list (- slack) slack logspan) ; x = [-inf, 0.bf]
-            (list (- (min lo-exp 0) slack) (+ lo-exp 1) logspan))] ; x = [-..., 0.bf]
-       [(crosses-zero? x) ; x = [-..., +...]
-        (cond
-          [(and (bfinfinite? hi) (bfinfinite? lo)) (list (- slack) slack logspan)] ; [-inf, +inf]
-          [(bfinfinite? hi)
-           (list (- (min lo-exp 0) slack) (+ (max lo-exp 0) slack) logspan)] ; [-..., +inf]
-          [(bfinfinite? lo)
-           (list (- (min hi-exp 0) slack) (+ (max hi-exp 0) slack) logspan)] ; [-inf, +...]
-          [else
-           (list (- (min lo-exp hi-exp 0) slack)
-                 (+ (max lo-exp hi-exp) 1)
-                 logspan)])] ; x = [-..., +...]
-       [else
-        (cond
-          ; Can't both be inf, since:
-          ;  - [inf, inf] not a valid interval
-          ;  - [-inf, inf] crosses zero
-          [(bfinfinite? lo) (list hi-exp (+ (max hi-exp 0) slack) logspan)] ; [-inf, -...]
-          [(bfinfinite? hi) (list lo-exp (+ (max lo-exp 0) slack) logspan)] ; [+..., +inf]
-          [else (list (min lo-exp hi-exp) (+ (max lo-exp hi-exp) 1) logspan)])])]))
+     ; minlog+maxlog
+     (match-define (list mn mx)
+       (cond
+         ; x = [0.bf, 0.bf]
+         [(and (bfzero? lo) (bfzero? hi)) (list (- slack) (- slack))]
+         [(bfzero? lo)
+          (if (bfinfinite? hi)
+              (list (- slack) slack) ; x = [0.bf, +inf]
+              (list (- (min hi-exp 0) slack) (+ hi-exp 1)))] ; x = [0.bf, +...]
+         [(bfzero? hi)
+          (if (bfinfinite? lo)
+              (list (- slack) slack) ; x = [-inf, 0.bf]
+              (list (- (min lo-exp 0) slack) (+ lo-exp 1)))] ; x = [-..., 0.bf]
+         [(crosses-zero? x) ; x = [-..., +...]
+          (cond
+            [(and (bfinfinite? hi) (bfinfinite? lo)) (list (- slack) slack)] ; [-inf, +inf]
+            [(bfinfinite? hi) (list (- (min lo-exp 0) slack) (+ (max lo-exp 0) slack))] ; [-..., +inf]
+            [(bfinfinite? lo) (list (- (min hi-exp 0) slack) (+ (max hi-exp 0) slack))] ; [-inf, +...]
+            [else
+             (list (- (min lo-exp hi-exp 0) slack) (+ (max lo-exp hi-exp) 1))])] ; x = [-..., +...]
+         [else
+          (cond
+            ; Can't both be inf, since:
+            ;  - [inf, inf] not a valid interval
+            ;  - [-inf, inf] crosses zero
+            [(bfinfinite? lo) (list hi-exp (+ (max hi-exp 0) slack))] ; [-inf, -...]
+            [(bfinfinite? hi) (list lo-exp (+ (max lo-exp 0) slack))] ; [+..., +inf]
+            [else (list (min lo-exp hi-exp) (+ (max lo-exp hi-exp) 1))])]))
+     ; output
+     (list x mn mx lg)]))
 
 (define (logspan x)
   (match (*bumps-activated*)
@@ -142,8 +142,8 @@
      ; Γ[*]'y     = 1
      ; ↑ampl[*]'y = logspan(x)
      ; ↓ampl[*]'y = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
+     (match-define (list _ _ _ lg-x) (first srcs))
+     (match-define (list _ _ _ lg-y) (second srcs))
      (list (cons lg-x 0) ; bounds per x
            (cons lg-y 0))] ; bounds per y
 
@@ -155,8 +155,8 @@
      ; Γ[/]'y     = 1
      ; ↑ampl[/]'y = logspan(x) + 2 * logspan(y)
      ; ↓ampl[/]'y = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
+     (match-define (list _ _ _ lg-x) (first srcs))
+     (match-define (list _ _ _ lg-y) (second srcs))
      (list (cons lg-y 0) ; bounds per x
            (cons (+ lg-x (* 2 lg-y)) 0))] ; bounds per y
 
@@ -168,7 +168,7 @@
      ; Γ[cbrt]'x     = 1/3
      ; ↑ampl[cbrt]'x = logspan(x)*2/3 - 1
      ; ↓ampl[cbrt]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
+     (match-define (list _ _ _ lg-x) (first srcs))
      (list (cons (quotient lg-x 2) 0))]
 
     [(ival-add ival-sub ival-add! ival-sub!)
@@ -179,9 +179,9 @@
      ; Γ[+ & -]'y     = |y/(x+y)| & |-y/(x-y)|
      ; ↑ampl[+ & -]'y = maxlog(y) - minlog(z)
      ; ↓ampl[+ & -]'y = minlog(y) - maxlog(z)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x _ mx-x _) (first srcs))
+     (match-define (list y _ mx-y _) (second srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (- mx-x mn-z)
@@ -199,9 +199,9 @@
      ; Γ[pow]'y     = |y*ln(x)|
      ; ↑ampl[pow]'y = maxlog(y) + max(|minlog(x)|,|maxlog(x)|) + logspan(z)
      ; ↓ampl[pow]'y = minlog(y)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x mn-x mx-x lg-x) (first srcs))
+     (match-define (list y _ mx-y _) (second srcs))
+     (match-define (list z _ _ lg-z) output)
 
      ; when output crosses zero and x is negative - means that y was fractional and not fixed (specific of Rival)
      ; solution - add more slack for y to converge
@@ -231,8 +231,8 @@
      ; Γ[exp & exp2]'x     = |x| & |x*ln(2)|
      ; ↑ampl[exp & exp2]'x = maxlog(x) + logspan(z)
      ; ↓ampl[exp & exp2]'x = minlog(x)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x _ mx-x _) (first srcs))
+     (match-define (list _ _ _ lg-z) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (+ mx-x lg-z) (minlog x #:less-slack #t)))
@@ -242,8 +242,8 @@
      ; Γ[tan]'x     = |x / (cos(x) * sin(x))|
      ; ↑ampl[tan]'x = maxlog(x) + max(|minlog(z)|,|maxlog(z)|) + logspan(z) + 1
      ; ↓ampl[tan]'x = minlog(x) + min(|minlog(z)|,|maxlog(z)|) - 1
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x _ mx-x _) (first srcs))
+     (match-define (list z mn-z mx-z lg-z) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (+ mx-x (max (abs mx-z) (abs mn-z)) lg-z 1)
@@ -257,8 +257,8 @@
      ; ↑ampl[sin]'x = maxlog(x) - minlog(z)
      ; ↓ampl[sin]'x = | - maxlog(z) - 1, if maxlog(x) > 1
      ;                | 0 else
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ mx-x _) (first srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (- mx-x mn-z)
@@ -271,8 +271,8 @@
      ; Γ[cos]'x     = |x * sin(x) / cos(x)|
      ; ↑ampl[cos]'x = maxlog(x) - minlog(z) + min(maxlog(x), 0)
      ; ↓ampl[cos]'x = - maxlog(x) - 2
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ mx-x _) (first srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (+ (- mx-x mn-z) (min mx-x 0)) (- (- 2) (maxlog z #:less-slack #t))))
@@ -282,8 +282,8 @@
      ; Γ[sinh]'x     = |x * cosh(x) / sinh(x)|
      ; ↑ampl[sinh]'x = maxlog(x) + logspan(z) - min(minlog(x), 0)
      ; ↓ampl[sinh]'x = max(0, minlog(x))
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x mn-x mx-x _) (first srcs))
+     (match-define (list _ _ _ lg-z) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (- (+ mx-x lg-z) (min mn-x 0)) (max 0 (minlog x #:less-slack #t))))
@@ -293,8 +293,8 @@
      ; Γ[cosh]'x     = |x * sinh(x) / cosh(x)|
      ; ↑ampl[cosh]'x = maxlog(x) + logspan(z) + min(maxlog(x), 0)
      ; ↓ampl[cosh]'x = max(0, minlog(x) - 1)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x _ mx-x lg-x) (first srcs))
+     (match-define (list _ _ _ lg-z) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (+ mx-x lg-z (min mx-x 0)) (max 0 (- (minlog x #:less-slack #t) 1))))
@@ -304,8 +304,8 @@
      ; Γ[log & log2 & log10]'x     = |1 / ln(x)| & |ln(2) / ln(x)| & |ln(10) / ln(x)|
      ; ↑ampl[log & log2 & log10]'x = logspan(x) - minlog(z) + 1
      ; ↓ampl[log & log2 & log10]'x = - maxlog(z)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ _ lg-x) (first srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (+ (- lg-x mn-z) 1) (- (maxlog z #:less-slack #t))))
@@ -316,7 +316,7 @@
      ; ↑ampl[asin]'x = | slack, if maxlog(z) > 1
      ;                 | 1 else
      ; ↓ampl[asin]'x = 0
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ mx-z _) output)
 
      (list (if (>= mx-z 1)
                (cons (get-slack) 0) ; assumes that log[1-x^2]/2 is equal to slack
@@ -327,7 +327,7 @@
      ; ↑ampl[acos]'x = | slack, if maxlog(x) >= 0
      ;                 | 0 else
      ; ↓ampl[acos]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
+     (match-define (list _ _ mx-x _) (first srcs))
 
      (list (if (>= mx-x 0)
                (cons (get-slack) 0) ; assumes that log[1-x^2]/2 is equal to slack
@@ -337,8 +337,8 @@
      ; Γ[atan]'x     = | x / ((1+x^2) * arctan(x))|
      ; ↑ampl[atan]'x = - min(|minlog(x)|, |maxlog(x)|) - minlog(z) + logspan(x)
      ; ↓ampl[atan]'x = - max(|minlog(x)|, |maxlog(x)|) - maxlog(z) - 2
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x mn-x mx-x lg-x) (first srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (list (cons (- lg-x (min (abs mn-x) (abs mx-x)) mn-z)
@@ -356,9 +356,9 @@
      ; Γ[mod]'y     ` |y/mod(x,y)|
      ; ↑ampl[mod]'y = maxlog(y) - minlog(z)
      ; ↓ampl[mod]'y = minlog(y) - maxlog(z) or just 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ mx-x _) (first srcs))
+     (match-define (list y _ _ _) (second srcs))
+     (match-define (list _ mn-z _ _) output)
 
      (define slack
        (if (crosses-zero? y)
@@ -374,8 +374,8 @@
      ; ↑ampl[log1p]'x = | maxlog(x) - minlog(z) + slack, if x is negative
      ;                  | maxlog(x) - minlog(z), else
      ; ↓ampl[log1p]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x _ mx-x _) (first srcs))
+     (match-define (list _ mn-z _ _) output)
 
      (define xhi (ival-hi x))
      (define xlo (ival-lo x))
@@ -389,18 +389,18 @@
      ; Γ[expm1]'x     = |x * e^x / expm1|
      ; ↑ampl[expm1]'x = max(1 + maxlog(x), 1 + maxlog(x) - minlog(z))
      ; ↓ampl[expm1]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ mx-x _) (first srcs))
+     (match-define (list _ mn-z _ _) output)
 
      (list (cons (max (+ 1 mx-x) (+ 1 (- mx-x mn-z))) 0))]
 
     [(ival-atan2)
      ; Γ[atan2]'x = Γ[atan2]'y = |xy / ((x^2 + y^2)*arctan(y/x))|
      ; ↑ampl[expm1]'x          = maxlog(x) + maxlog(y) - 2*min(minlog(x), minlog(y)) - minlog(z)
      ; ↓ampl[expm1]'x          = minlog(x) + minlog(y) - 2*max(maxlog(x), maxlog(y)) - maxlog(z)
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons y (list mn-y mx-y lg-y)) (second srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list x mn-x mx-x _) (first srcs))
+     (match-define (list y mn-y mx-y _) (second srcs))
+     (match-define (list z mn-z _ _) output)
 
      (if (*lower-bound-early-stopping*)
          (make-list 2
@@ -414,8 +414,8 @@
      ; Γ[tanh]'x     = |x / (sinh(x) * cosh(x))|
      ; ↑ampl[tanh]'x = logspan(z) + logspan(x)
      ; ↓ampl[tanh]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ _ _ lg-x) (first srcs))
+     (match-define (list _ _ _ lg-z) output)
 
      (list (cons (+ lg-z lg-x) 0))]
 
@@ -424,7 +424,7 @@
      ; ↑ampl[atanh]'x = | 1, if x < 0.5
      ;                  | slack
      ; ↓ampl[atanh]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
+     (match-define (list _ _ mx-x _) (first srcs))
      (list (if (>= mx-x 1)
                (cons (get-slack) 0)
                (cons 1 0)))]
@@ -434,7 +434,7 @@
      ; ↑ampl[acosh]'x = | -minlog(z) + slack, if minlog(z) < 2
      ;                  | 0
      ; ↓ampl[acosh]'x = 0
-     (match-define (cons z (list mn-z mx-z lg-z)) output)
+     (match-define (list _ mn-z _ _) output)
      (list (if (< mn-z 2) ; when acosh(x) < 1
                (cons (- (get-slack) mn-z) 0)
                (cons 0 0)))]
@@ -443,7 +443,7 @@
      ; Γ[acosh]'x = |2 x x* / x^2|
      ; ↑ampl[pow2]'x = logspan(x) + 1
      ; ↓ampl[pow2]'x = 0
-     (match-define (cons x (list mn-x mx-x lg-x)) (first srcs))
+     (match-define (list _ _ _ lg-x) (first srcs))
      (list (cons (+ lg-x 1) 0))]
 
     ; TODO
