Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for issue 1058 #1071

Draft
wants to merge 1 commit into
base: main
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 6 additions & 2 deletions src/api/sandbox.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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`
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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)]
Expand Down
14 changes: 10 additions & 4 deletions src/api/server.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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))))
Expand Down Expand Up @@ -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])
Expand All @@ -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])
Expand Down
54 changes: 52 additions & 2 deletions src/reports/common.rkt
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down Expand Up @@ -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]
Expand All @@ -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]
Expand Down Expand Up @@ -303,6 +352,7 @@
string-append)
prelude-lines
out)))))))
(eprintf "versions: ~a\n" versions)

(define math-out
(if (dict-has-key? versions "TeX")
Expand Down
Loading