diff --git a/infra/ci.rkt b/infra/ci.rkt index f4bd50455..a09a8ab0f 100644 --- a/infra/ci.rkt +++ b/infra/ci.rkt @@ -44,7 +44,7 @@ (override-test-precision the-test (*precision*)) the-test)) (define result (run-herbie 'improve the-test* #:seed seed)) - (match-define (job-result _ test status time timeline warnings backend) result) + (match-define (job-result _ test status time timeline profile warnings backend) result) (match status ['success (match-define (improve-result preprocess pctxs start targets end bogosity) backend) diff --git a/infra/testApi.mjs b/infra/testApi.mjs index ea3404c5a..b6f97ac99 100644 --- a/infra/testApi.mjs +++ b/infra/testApi.mjs @@ -304,7 +304,7 @@ assert.equal(mathjs.mathjs, "sqrt(x + 1.0) - sqrt(x)") const expectedExpressions = { "python": 'def expr(x):\n\treturn math.sqrt((x + 1.0)) - math.sqrt(x)\n', "c": 'double expr(double x) {\n\treturn sqrt((x + 1.0)) - sqrt(x);\n}\n', - "fortran": 'real(8) function expr(x)\n real(8), intent (in) :: x\n expr = sqrt((x + 1.0d0)) - sqrt(x)\nend function\n', + "fortran": 'real(8) function expr(x)\nuse fmin_fmax_functions\n real(8), intent (in) :: x\n expr = sqrt((x + 1.0d0)) - sqrt(x)\nend function\n', "java": 'public static double expr(double x) {\n\treturn Math.sqrt((x + 1.0)) - Math.sqrt(x);\n}\n', "julia": 'function expr(x)\n\treturn Float64(sqrt(Float64(x + 1.0)) - sqrt(x))\nend\n', "matlab": 'function tmp = expr(x)\n\ttmp = sqrt((x + 1.0)) - sqrt(x);\nend\n', diff --git a/src/api/run.rkt b/src/api/run.rkt index 2eb331965..d11741073 100644 --- a/src/api/run.rkt +++ b/src/api/run.rkt @@ -95,7 +95,7 @@ ([test (in-list tests)]) (values (start-job - (create-job 'improve test #:seed seed #:pcontext #f #:profile? #f #:timeline-disabled? #f)) + (create-job 'improve test #:seed seed #:pcontext #f #:profile? #t #:timeline-disabled? #f)) (test-name test)))) (define info diff --git a/src/api/sandbox.rkt b/src/api/sandbox.rkt index d740a81fd..6733503a8 100644 --- a/src/api/sandbox.rkt +++ b/src/api/sandbox.rkt @@ -35,7 +35,7 @@ (struct-out improve-result) (struct-out alt-analysis)) -(struct job-result (command test status time timeline warnings backend)) +(struct job-result (command test status time timeline profile warnings backend)) (struct improve-result (preprocess pctxs start target end bogosity)) (struct alt-analysis (alt train-errors test-errors) #:prefab) @@ -245,6 +245,7 @@ #:profile? [profile? #f] #:timeline-disabled? [timeline-disabled? #f]) (define timeline #f) + (define profile #f) ;; CS versions <= 8.2: problems with scheduler cause places to stay ;; in a suspended state @@ -256,7 +257,7 @@ (timeline-event! 'end) (define time (- (current-inexact-milliseconds) start-time)) (match command - ['improve (job-result command test 'failure time (timeline-extract) (warning-log) e)] + ['improve (job-result command test 'failure time (timeline-extract) #f (warning-log) e)] [_ (raise e)]))) (define (on-timeout) @@ -264,10 +265,11 @@ (timeline-load! timeline) (timeline-event! 'end) (match command - ['improve (job-result command test 'timeout (*timeout*) (timeline-extract) (warning-log) #f)] + ['improve + (job-result command test 'timeout (*timeout*) (timeline-extract) #f (warning-log) #f)] [_ (error 'run-herbie "command ~a timed out" command)]))) - (define (compute-result test) + (define (compute-result) (parameterize ([*timeline-disabled* timeline-disabled?]) (define start-time (current-inexact-milliseconds)) (reset!) @@ -293,15 +295,18 @@ [_ (error 'compute-result "unknown command ~a" command)])) (timeline-event! 'end) (define time (- (current-inexact-milliseconds) start-time)) - (job-result command test 'success time (timeline-extract) (warning-log) result)))) + (job-result command test 'success time (timeline-extract) #f (warning-log) result)))) (define (in-engine _) - (if profile? - (profile-thunk (λ () (compute-result test)) - #:order 'total - #:delay 0.01 - #:render (λ (p order) (write-json (profile->json p) profile?))) - (compute-result test))) + (cond + [profile? + (define result + (profile-thunk compute-result + #:order 'total + #:delay 0.01 + #:render (λ (p order) (set! profile (profile->json p))))) + (struct-copy job-result result [profile profile])] + [else (compute-result)])) ;; Branch on whether or not we should run inside an engine (define eng (engine in-engine)) @@ -447,7 +452,7 @@ [_ (error 'get-table-data "unknown result type ~a" status)])) (define (get-table-data result link) - (match-define (job-result command test status time _ _ backend) result) + (match-define (job-result command test status time _ _ _ backend) result) (match status ['success (match-define (improve-result _ _ start targets end _) backend) diff --git a/src/api/server.rkt b/src/api/server.rkt index 7c075bbcb..9aa99d13a 100644 --- a/src/api/server.rkt +++ b/src/api/server.rkt @@ -142,7 +142,7 @@ (define (herbie-do-server-job command job-id) (define herbie-result (wrapper-run-herbie command job-id)) - (match-define (job-result kind test status time _ _ backend) herbie-result) + (match-define (job-result kind test status time _ _ _ backend) herbie-result) (match kind ['alternatives (make-alternatives-result herbie-result test job-id)] ['evaluate (make-calculate-result herbie-result job-id)] @@ -457,6 +457,7 @@ (define job-time (job-result-time herbie-result)) (define warnings (job-result-warnings herbie-result)) (define timeline (job-result-timeline herbie-result)) + (define profile (job-result-profile herbie-result)) (define repr (test-output-repr test)) (define backend-hash @@ -479,6 +480,8 @@ warnings 'timeline timeline + 'profile + profile 'backend backend-hash 'job diff --git a/src/reports/pages.rkt b/src/reports/pages.rkt index 5939b5bbe..2f5403bea 100644 --- a/src/reports/pages.rkt +++ b/src/reports/pages.rkt @@ -15,7 +15,7 @@ (define (all-pages result-hash) (define good? (eq? (hash-ref result-hash 'status) 'success)) (define default-pages '("graph.html" "timeline.html" "timeline.json")) - (define success-pages '("points.json")) + (define success-pages '("points.json" "profile.json")) (append default-pages (if good? success-pages empty))) (define ((page-error-handler result-hash page out) e) @@ -40,6 +40,7 @@ #:path "..") out)] ["timeline.json" (write-json (hash-ref result-hash 'timeline) out)] + ["profile.json" (write-json (hash-ref result-hash 'profile) out)] ["points.json" (write-json (make-points-json result-hash) out)])) (define (make-graph-html result-hash output? profile?)