Merge pull request #1351 from herbie-fp/batch-no-roots

Batch without `roots` field

Author: AYadrov

src/api/sandbox.rkt

@@ -82,7 +82,7 @@
 
   ;; compute error/cost for output expression
   ;; and sort alternatives by accuracy + cost on testing subset
-  (define test-errs (batch-errors (map alt-expr alternatives) test-pcontext (*context*)))
+  (define test-errs (exprs-errors (map alt-expr alternatives) test-pcontext (*context*)))
   (define sorted-end-exprs (sort-alts alternatives test-errs))
   (define end-exprs (map (compose alt-expr car) sorted-end-exprs))
   (define end-errs (map cdr sorted-end-exprs))

src/api/server.rkt

@@ -515,7 +515,7 @@
                       (improve-result-target backend)
                       (improve-result-end backend))))
        (define exprs (append-map collect-expressions all-alts))
-       (make-hash (map cons exprs (batch-errors exprs pcontext ctx)))]
+       (make-hash (map cons exprs (exprs-errors exprs pcontext ctx)))]
       [else #f]))
 
   (define test-fpcore (alt->fpcore test (make-alt (test-input test))))

src/core/alt-table.rkt

@@ -26,25 +26,22 @@
 
 (struct alt-table (point-idx->alts alt->point-idxs alt->done? alt->cost pcontext all) #:prefab)
 
-(define (alt-batch-cost batch repr)
+(define (alt-batch-cost batch brfs repr)
   (define node-cost-proc (platform-node-cost-proc (*active-platform*)))
-  (define costs (make-vector (batch-length batch) 0))
-  (for ([node (in-batch batch)]
-        [i (in-naturals)])
-    (define cost
-      (match node
-        [(? literal?) ((node-cost-proc node repr))]
-        [(? symbol?) ((node-cost-proc node repr))]
-        [(? number?) 0] ; specs
-        [(approx _ impl) (vector-ref costs impl)]
-        [(list (? (negate impl-exists?) impl) args ...) 0] ; specs
-        [(list impl args ...)
-         (define cost-proc (node-cost-proc node repr))
-         (define itypes (impl-info impl 'itype))
-         (apply cost-proc (map (curry vector-ref costs) args))]))
-    (vector-set! costs i cost))
-  (for/list ([root (in-vector (batch-roots batch))])
-    (vector-ref costs root)))
+  (define costs
+    (batch-map batch
+               (λ (get-args-costs node)
+                 (match node
+                   [(? literal?) ((node-cost-proc node repr))]
+                   [(? symbol?) ((node-cost-proc node repr))]
+                   [(? number?) 0] ; specs
+                   [(approx _ impl) (get-args-costs impl)]
+                   [(list (? (negate impl-exists?) impl) args ...) 0] ; specs
+                   [(list impl args ...)
+                    (define cost-proc (node-cost-proc node repr))
+                    (define itypes (impl-info impl 'itype))
+                    (apply cost-proc (map get-args-costs args))]))))
+  (map costs brfs))
 
 (define (make-alt-table pcontext initial-alt ctx)
   (define cost (alt-cost initial-alt (context-repr ctx)))
@@ -184,9 +181,9 @@
                [alt->cost (hash-remove* alt->cost altns)]))
 
 (define (atab-eval-altns atab altns ctx)
-  (define batch (progs->batch (map alt-expr altns) #:vars (context-vars ctx)))
-  (define errss (batch-errors batch (alt-table-pcontext atab) ctx))
-  (define costs (alt-batch-cost batch (context-repr ctx)))
+  (define-values (batch brfs) (progs->batch (map alt-expr altns) #:vars (context-vars ctx)))
+  (define errss (batch-errors batch brfs (alt-table-pcontext atab) ctx))
+  (define costs (alt-batch-cost batch brfs (context-repr ctx)))
   (values errss costs))
 
 (define (atab-add-altns atab altns errss costs ctx)