Merge pull request #114 from herbie-fp/fix-112

Adding tuning formulas for `tanu`, `cosu` and `sinu`, fix #112

Author: pavpanchekha

eval/adjust.rkt

@@ -154,6 +154,7 @@
   (define vbest-precs (rival-machine-best-known-precisions machine))
   (define current-iter (rival-machine-iteration machine))
   (define bumps (rival-machine-bumps machine))
+  (define constants-lookup (rival-machine-constant-lookup machine))
 
   (define first-tuning-pass? (equal? 1 current-iter))
   (define varc (vector-length args))
@@ -187,7 +188,7 @@
       [else (path-reduction vrepeats vregs varc instr i #:reexec-val #f)]))
 
   ; Step 2. Precision tuning
-  (precision-tuning ivec vregs vprecs-new varc vstart-precs vrepeats vhint)
+  (precision-tuning ivec vregs vprecs-new varc vstart-precs vrepeats vhint constants-lookup)
 
   ; Step 3. Repeating precisions check + Assigning if a operation should be computed again at all
   ; vrepeats[i] = #t if the node has the same precision as an iteration before and children have #t flag as well
@@ -226,7 +227,7 @@
     ; clean progress of the current tuning pass and start over
     (vector-fill! vprecs-new 0)
     (vector-fill! vrepeats #f)
-    (precision-tuning ivec vregs vprecs-new varc vstart-precs vrepeats vhint)
+    (precision-tuning ivec vregs vprecs-new varc vstart-precs vrepeats vhint constants-lookup)
     (repeats)) ; do repeats again
 
   ; Step 5. Copying new precisions into vprecs
@@ -244,17 +245,18 @@
 ; Roughly speaking, the upper precision bound is calculated as:
 ;   vprecs-max[i] = (+ max-prec vstart-precs[i]), where min-prec < (+ max-prec vstart-precs[i]) < max-prec
 ;   max-prec = (car (get-bounds parent))
-(define (precision-tuning ivec vregs vprecs-max varc vstart-precs vrepeats vhint)
+(define (precision-tuning ivec vregs vprecs-max varc vstart-precs vrepeats vhint constants)
   (define vprecs-min (make-vector (vector-length ivec) 0))
   (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)]
+        [constant (in-vector constants (- (vector-length constants) 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) (vector-ref vregs x)) tail-registers))
+    (define srcs (append (map (lambda (x) (vector-ref vregs x)) tail-registers) constant))
 
     (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

eval/compile.rkt

@@ -19,7 +19,7 @@
 (define *rival-use-shorthands* (make-parameter #t))
 (define *rival-name-constants* (make-parameter #f))
 
-(define (fn->ival-fn node alloc-outreg!)
+(define (fn->ival-fn node alloc-outreg! [constants #f] [i #f])
   (match node
     [(? number?)
      (if (ival-point? (real->ival node))
@@ -89,9 +89,18 @@
 
     [(list 'pow2 x) (list ival-pow2 x)]
 
-    [(list `(cosu ,n) x) (list (ival-cosu n) x)]
-    [(list `(sinu ,n) x) (list (ival-sinu n) x)]
-    [(list `(tanu ,n) x) (list (ival-tanu n) x)]
+    [(list `(cosu ,n) x)
+     (when i
+       (vector-set! constants i (exact-floor (log n))))
+     (list (ival-cosu n) x)]
+    [(list `(sinu ,n) x)
+     (when i
+       (vector-set! constants i (exact-floor (log n))))
+     (list (ival-sinu n) x)]
+    [(list `(tanu ,n) x)
+     (when i
+       (vector-set! constants i (exact-floor (log n))))
+     (list (ival-tanu n) x)]
 
     [(list '== x y) (list ival-== x y)]
     [(list '!= x y) (list ival-!= x y)]
@@ -279,14 +288,18 @@
   (define register-count (+ (length vars) ivec-length))
   (define registers (make-vector register-count))
 
+  (define constants-lookup (make-vector ivec-length '()))
+
   (define instructions
     (for/vector #:length ivec-length
                 ([node (in-vector nodes num-vars)]
                  [n (in-naturals num-vars)])
       (fn->ival-fn node
                    (lambda ()
                      (vector-set! registers n (new-ival))
-                     n))))
+                     n)
+                   constants-lookup
+                   (- n num-vars))))
 
   (define precisions (make-vector ivec-length)) ; vector that stores working precisions
   (define initial-precisions (setup-vstart-precs instructions num-vars roots discs))
@@ -311,6 +324,7 @@
                  best-known-precisions
                  (make-vector (vector-length roots))
                  default-hint
+                 constants-lookup
                  0
                  0
                  0

eval/machine.rkt

@@ -33,6 +33,7 @@
                    best-known-precisions
                    output-distance
                    default-hint
+                   constant-lookup
                    [iteration #:mutable]
                    [bumps #:mutable]
                    [profile-ptr #:mutable]

eval/tricks.rkt

@@ -378,6 +378,27 @@
      (define x (first srcs))
      (list (cons (+ (logspan x) 1) 0))]
 
+    [(ival-sinu ival-cosu)
+     ; Γ[sinu]'x = |x*pi/n * cos(x*pi/n) / sin(x*pi/n)|
+     ; Γ[cosu]'x = |x*pi/n * sin(x*pi/n) / cos(x*pi/n)|
+     ;
+     ; ↑ampl[sinu]'x = ↑ampl[sinu]'n = maxlog(x) - minlog(n) - minlog(z) + 2 (accounting for pi)
+     ; ↓ampl[sinu]'x = ↓ampl[sinu]'n = 0 <-- maybe can be better
+     ;
+     ; ↑ampl[cosu]'x = ↑ampl[cosu]'n = maxlog(x) - minlog(n) - minlog(z) + 2 (accounting for pi)
+     ; ↓ampl[cosu]'x = ↓ampl[cosu]'n = 0 <-- maybe can be better
+     (define x (car srcs))
+     (define n (cdr srcs)) ; n is already a floor(log(n))
+     (list (cons (- (maxlog x) n (minlog z) -2) 0))]
+
+    [(ival-tanu)
+     ; Γ[tanu]'x = |x*pi/n * (1 / cos^2(x*pi/n)) / tan(x*pi/n)|
+     ; ↑ampl[tanu]'x = ↑ampl[tanu]'n = maxlog(x) - minlog(n) + max(|minlog(z)|, |maxlog(z)|) + 3 (accounting for pi)
+     ; ↓ampl[tanu]'x = ↓ampl[tanu]'n = 0 <-- maybe can be better
+     (define x (car srcs))
+     (define n (cdr srcs)) ; n is already a floor(log(n))
+     (list (cons (- (maxlog x) n (- (max (abs (maxlog z)) (abs (minlog z)))) -3) 0))]
+
     ; TODO
     ; ↑ampl[...] = slack
     ; ↓ampl[...] = 0