Merge branch 'main' into fix-nondet

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)

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',

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

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,18 +257,19 @@
       (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)
     (parameterize ([*timeline-disabled* timeline-disabled?])
       (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)

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

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?)