Merge pull request #1282 from herbie-fp/codex/refactor--start-prog--global-usage

Pass start program explicitly

Author: pavpanchekha

src/core/bsearch.rkt

@@ -32,13 +32,13 @@
 ;; The last splitpoint uses +nan.0 for pt and represents the "else"
 (struct sp (cidx bexpr point) #:prefab)
 
-(define (combine-alts best-option ctx)
+(define (combine-alts best-option start-prog ctx)
   (match-define (option splitindices alts pts expr _) best-option)
   (match splitindices
     [(list (si cidx _)) (list-ref alts cidx)]
     [_
      (timeline-event! 'bsearch)
-     (define splitpoints (sindices->spoints pts expr alts splitindices ctx))
+     (define splitpoints (sindices->spoints pts expr alts splitindices start-prog ctx))
 
      (define expr*
        (for/fold ([expr (alt-expr (list-ref alts (sp-cidx (last splitpoints))))])
@@ -119,16 +119,16 @@
 ;; float form always come from the range [f(idx1), f(idx2)). If the
 ;; float form of a split is f(idx2), or entirely outside that range,
 ;; problems may arise.
-(define/contract (sindices->spoints points expr alts sindices ctx)
-  (-> (listof vector?) any/c (listof alt?) (listof si?) context? valid-splitpoints?)
+(define/contract (sindices->spoints points expr alts sindices start-prog ctx)
+  (-> (listof vector?) any/c (listof alt?) (listof si?) any/c context? valid-splitpoints?)
   (define repr (repr-of expr ctx))
 
   (define eval-expr (compile-prog expr ctx))
 
   (define var (gensym 'branch))
   (define ctx* (context-extend ctx var repr))
   (define progs (map (compose (curryr extract-subexpression var expr ctx) alt-expr) alts))
-  (define start-prog (extract-subexpression (*start-prog*) var expr ctx))
+  (define start-prog-sub (extract-subexpression start-prog var expr ctx))
 
   ; Not totally clear if this should actually use the precondition
   (define start-real-compiler
@@ -163,7 +163,7 @@
   (define use-binary
     (and (flag-set? 'reduce 'binary-search)
          ;; Binary search is only valid if we correctly extracted the branch expression
-         (andmap identity (cons start-prog progs))))
+         (andmap identity (cons start-prog-sub progs))))
 
   (append (for/list ([si1 sindices]
                      [si2 (cdr sindices)])

src/core/mainloop.rkt

@@ -30,6 +30,9 @@
 (define/reset ^patched^ #f)
 (define/reset ^table^ #f)
 
+;; Starting program for the current run
+(define *start-prog* (make-parameter #f))
+
 ;; These high-level functions give the high-level workflow of Herbie:
 ;; - Initial steps: explain, preprocessing, initialize the alt table
 ;; - the loop: choose some alts, localize, run the patch table, and finalize
@@ -66,7 +69,7 @@
   (timeline-push-alts! '())
 
   (define all-alts (atab-all-alts (^table^)))
-  (define joined-alts (make-regime! all-alts)) ;; HERE
+  (define joined-alts (make-regime! all-alts (*start-prog*))) ;; HERE
   (define annotated-alts (add-derivations! joined-alts))
 
   (timeline-push! 'stop (if (atab-completed? (^table^)) "done" "fuel") 1)
@@ -237,7 +240,7 @@
   (finalize-iter!)
   (void))
 
-(define (make-regime! alts)
+(define (make-regime! alts start-prog)
   (define ctx (*context*))
   (define repr (context-repr ctx))
 
@@ -247,9 +250,9 @@
           (equal? (representation-type repr) 'real)
           (not (null? (context-vars ctx)))
           (get-fpcore-impl '<= '() (list repr repr)))
-     (define opts (pareto-regimes (sort alts < #:key (curryr alt-cost repr)) ctx))
+     (define opts (pareto-regimes (sort alts < #:key (curryr alt-cost repr)) start-prog ctx))
      (for/list ([opt (in-list opts)])
-       (combine-alts opt ctx))]
+       (combine-alts opt start-prog ctx))]
     [else (list (argmin score-alt alts))]))
 
 (define (add-derivations! alts)

src/core/regimes.rkt

@@ -25,13 +25,13 @@
   [(define (write-proc opt port mode)
      (fprintf port "#<option ~a>" (option-split-indices opt)))])
 
-(define (pareto-regimes sorted ctx)
+(define (pareto-regimes sorted start-prog ctx)
   (timeline-event! 'regimes)
   (define err-lsts (batch-errors (map alt-expr sorted) (*pcontext*) ctx))
   (define branches
     (if (null? sorted)
         '()
-        (exprs-to-branch-on sorted ctx)))
+        (exprs-to-branch-on sorted start-prog ctx)))
   (define branch-exprs
     (if (flag-set? 'reduce 'branch-expressions)
         branches
@@ -87,11 +87,11 @@
   (timeline-push! 'oracle (errors-score (map (curry apply max) err-lsts)))
   (values best errs))
 
-(define (exprs-to-branch-on alts ctx)
+(define (exprs-to-branch-on alts start-prog ctx)
   (define alt-critexprs
     (for/list ([alt (in-list alts)])
       (all-critical-subexpressions (alt-expr alt) ctx)))
-  (define start-critexprs (all-critical-subexpressions (*start-prog*) ctx))
+  (define start-critexprs (all-critical-subexpressions start-prog ctx))
   ;; We can only binary search if the branch expression is critical
   ;; for all of the alts and also for the start prgoram.
   (filter (λ (e) (equal? (representation-type (repr-of e ctx)) 'real))
@@ -151,8 +151,7 @@
 
 (module+ test
   (define ctx (make-debug-context '(x)))
-  (parameterize ([*start-prog* (literal 1 'binary64)]
-                 [*pcontext* (mk-pcontext '(#(0.5) #(4.0)) '(1.0 1.0))])
+  (parameterize ([*pcontext* (mk-pcontext '(#(0.5) #(4.0)) '(1.0 1.0))])
     (define alts (map make-alt (list '(fmin.f64 x 1) '(fmax.f64 x 1))))
     (define err-lsts `((,(expt 2.0 53) 1.0) (1.0 ,(expt 2.0 53))))
 

src/utils/alternative.rkt

@@ -6,7 +6,6 @@
          alt?
          alt-expr
          alt-add-event
-         *start-prog*
          *all-alts*
          alt-cost
          alt-equal?
@@ -43,9 +42,5 @@
 (define (alt-map f altn)
   (f (struct-copy alt altn [prevs (map (curry alt-map f) (alt-prevs altn))])))
 
-;; A useful parameter for many of Herbie's subsystems, though
-;; ultimately one that should be located somewhere else or perhaps
-;; exorcised
-
-(define *start-prog* (make-parameter #f))
+;; Keeps track of all alts so far.
 (define *all-alts* (make-parameter '()))