Gotta hit pause for now.

herbie-fp · Nov 22, 2024 · a938fc3 · a938fc3
1 parent 1345676
commit a938fc3
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 8 deletions.
diff --git a/src/api/sandbox.rkt b/src/api/sandbox.rkt
@@ -179,7 +179,7 @@
   (define test-pcontext* (preprocess-pcontext (*context*) test-pcontext preprocessing))
   (when seed
     (set-seed! seed))
-  (list alternatives test-pcontext test-pcontext*))
+  (list alternatives test-pcontext test-pcontext* preprocessing))
 
 ;; Improvement backend for generating reports
 ;; A more heavyweight version of `get-alternatives`
@@ -224,6 +224,7 @@
 
   ;; compute error/cost for output expression
   (define end-exprs (map alt-expr end-alts))
+
   (define end-train-errs (flip-lists (batch-errors end-exprs train-pcontext ctx)))
   (define end-test-errs (flip-lists (batch-errors end-exprs test-pcontext* ctx)))
   (define end-alts-data (map alt-analysis end-alts end-train-errs end-test-errs))
@@ -283,7 +284,10 @@
         (timeline-event! 'start) ; Prevents the timeline from being empty.
         (define result
           (match command
-            ['alternatives (get-alternatives test pcontext seed)]
+            ['alternatives
+             (define out (get-alternatives test pcontext seed))
+             (eprintf "~a: result: ~a\n" command (first out))
+             out]
             ['evaluate (get-calculation test pcontext)]
             ['cost (get-cost test)]
             ['errors (get-errors test pcontext)]

diff --git a/src/api/server.rkt b/src/api/server.rkt
@@ -507,7 +507,6 @@
                ([analysis end])
                (match-define (alt-analysis alt train-errors test-errs) analysis)
                (values alt train-errors test-errs (alt-cost alt repr))))
-
   (define alts-histories
     (for/list ([alt end-alts])
       (render-history alt (first pcontexts) (second pcontexts) (test-context test))))
@@ -545,7 +544,8 @@
   (define vars (test-vars test))
   (define repr (test-output-repr test))
 
-  (match-define (list altns test-pcontext processed-pcontext) (job-result-backend herbie-result))
+  (match-define (list altns test-pcontext processed-pcontext preprocessing)
+    (job-result-backend herbie-result))
   (define splitpoints
     (for/list ([alt altns])
       (for/list ([var vars])
@@ -556,8 +556,14 @@
             '()))))
 
   (define fpcores
-    (for/list ([altn altns])
-      (~a (program->fpcore (alt-expr altn) (test-context test)))))
+    (for/list ([expr (map alt-expr altns)])
+      (define out (fpcore-with-preprocessing expr
+                                                 (test-context test)
+                                                 #:ident (test-identifier test)
+                                                 #:instructions preprocessing))
+      (~s  out)))
+
+  (eprintf "alts: ~a\n" fpcores)
 
   (define histories
     (for/list ([altn altns])

diff --git a/src/reports/common.rkt b/src/reports/common.rkt
@@ -49,7 +49,8 @@
          core->wls
          core->tex
          expr->tex
-         core->js)
+         core->js
+         fpcore-with-preprocessing)
 
 (define (write-html xexpr out)
   (fprintf out "<!doctype html>\n")
@@ -258,6 +259,54 @@
 
 (define sort-note "NOTE: ~a should be sorted in increasing order before calling this function.")
 
+(define (fpcore-with-preprocessing expr
+                                   ctx
+                                   #:ident [identifier #f]
+                                   #:pre [precondition '(TRUE)]
+                                   #:instructions [instructions empty])
+  (define output-repr (context-repr ctx))
+  (match-define (cons expr* ctx*)
+    (foldl (match-lambda*
+             [(list i (cons e c)) (combine-fpcore-instruction i e c)])
+           (cons expr ctx)
+           instructions))
+  (define out-prog
+    (parameterize ([*expr-cse-able?* at-least-two-ops?])
+      (core-cse (program->fpcore expr* ctx* #:ident identifier))))
+
+  (define output-prec (representation-name output-repr))
+  (define out-prog* (fpcore-add-props out-prog (list ':precision output-prec)))
+  (define versions
+    (reap
+     [sow]
+     (for ([(lang record) (in-dict languages)])
+       (match-define (list ext converter) record)
+       (when (and (fpcore? out-prog*) (or (equal? ext "fpcore") (supported-by-lang? out-prog* ext)))
+         (define name
+           (if identifier
+               (symbol->string identifier)
+               "code"))
+         (define out (converter out-prog* name))
+         (define prelude-lines
+           (string-join
+            (append-map (lambda (instruction)
+                          (let ([l (format-prelude-instruction instruction ctx ctx* lang converter)])
+                            (if (list? l)
+                                l
+                                (list l))))
+                        instructions)
+            (if (equal? lang "TeX") "\\\\\n" "\n")
+            #:after-last "\n"))
+         (sow (cons lang
+                    ((if (equal? lang "TeX")
+                         (curry format "\\begin{array}{l}\n~a\\\\\n~a\\end{array}\n")
+                         string-append)
+                     prelude-lines
+                     out)))))))
+  (match-define (cons left right) (first versions))
+  (eprintf "fpcore?; ~a\n" right)
+  right)
+
 (define (render-program expr
                         ctx
                         #:ident [identifier #f]
@@ -275,7 +324,7 @@
 
   (define output-prec (representation-name output-repr))
   (define out-prog* (fpcore-add-props out-prog (list ':precision output-prec)))
-
+  (eprintf "langs: ~a\n" languages)
   (define versions
     (reap
      [sow]
@@ -303,6 +352,7 @@
                          string-append)
                      prelude-lines
                      out)))))))
+  (eprintf "versions: ~a\n" versions)
 
   (define math-out
     (if (dict-has-key? versions "TeX")