diff --git a/src/api/sandbox.rkt b/src/api/sandbox.rkt index 9f1f3a650..3e2d0fc3b 100644 --- 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 index 1033abea7..872f932ea 100644 --- 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 index fd8743f9b..46ff11f34 100644 --- 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 "\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")