Script to measure form performance regression

.github/workflows/benchmarks.yml

@@ -25,7 +25,7 @@ jobs:
         run: make install-sdk
       - name: Run benchmark
         shell: 'bash --noprofile --norc -eo pipefail {0}'
-        run: make report-benchmarks | tee benchmarks.txt
+        run: make form-performance-report | tee benchmarks.txt
       - name: Store benchmark result
         uses: benchmark-action/github-action-benchmark@v1
         with:

Makefile

@@ -39,7 +39,7 @@ help:
 	@echo "profile-competitive - Run competitive benchmarks"
 	@echo "profile-forms - Run benchmarks for individual Qi forms"
 	@echo "profile-selected-forms - Run benchmarks for Qi forms by name (command only)"
-	@echo "report-benchmarks - Run benchmarks for Qi forms and produce results for use in CI"
+	@echo "form-performance-report - Run benchmarks for Qi forms and produce results for use in CI"
 
 # Primarily for use by CI.
 # Installs dependencies as well as linking this as a package.
@@ -82,6 +82,9 @@ build-standalone-docs:
 clean:
 	raco setup --fast-clean --pkgs $(PACKAGE-NAME)-{lib,test,doc,probe}
 
+clean-sdk:
+	raco setup --fast-clean --pkgs $(PACKAGE-NAME)-sdk
+
 # Primarily for use by CI, after make install -- since that already
 # does the equivalent of make setup, this tries to do as little as
 # possible except checking deps.
@@ -161,18 +164,18 @@ cover-coveralls:
 
 profile-forms:
 	echo "Profiling forms..."
-	racket profile/forms.rkt
+	racket $(PACKAGE-NAME)-sdk/profile/forms.rkt
 
 profile-selected-forms:
-	@echo "Use 'racket profile/forms.rkt' directly, with -f form-name for each form."
+	@echo "Use 'racket $(PACKAGE-NAME)-sdk/profile/forms.rkt' directly, with -f form-name for each form."
 
 profile-competitive:
 	echo "Running competitive benchmarks..."
-	racket profile/competitive.rkt
+	racket $(PACKAGE-NAME)-sdk/profile/competitive.rkt
 
 profile: profile-competitive profile-forms
 
-report-benchmarks:
+form-performance-report:
 	@racket $(PACKAGE-NAME)-sdk/profile/report.rkt
 
-.PHONY:	help install remove build build-docs build-all clean check-deps test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile-forms profile-selected-forms profile-competitive profile report-benchmarks
+.PHONY:	help install remove build build-docs build-all clean check-deps test test-flow test-on test-threading test-switch test-definitions test-macro test-util test-probe test-with-errortrace errortrace errortrace-flow errortrace-on errortrace-threading errortrace-switch errortrace-definitions errortrace-macro errortrace-util errortrace-probe docs cover coverage-check coverage-report cover-coveralls profile-forms profile-selected-forms profile-competitive profile form-performance-report

qi-sdk/info.rkt

@@ -9,6 +9,7 @@
                "math-lib"
                "collections-lib"
                "relation-lib"
+               "csv-writing"
                "cover"
                "cover-coveralls"))
 (define build-deps '())

qi-sdk/profile/competitive.rkt

@@ -1,3 +1,4 @@
+#!/usr/bin/env racket
 #lang racket/base
 
 (require (only-in data/collection

qi-sdk/profile/forms.rkt

@@ -1,3 +1,4 @@
+#!/usr/bin/env racket
 #lang racket/base
 
 #|
@@ -1042,6 +1043,10 @@ for the forms are run.
 
   (constraint (multi forms))
 
+  (help
+   (usage (~a "Run benchmarks for individual Qi forms "
+              "(by default, all of them).")))
+
   (program (main)
     (let ([fs (~>> ((forms))
                    (only-if null?

qi-sdk/profile/regression.rkt

@@ -0,0 +1,63 @@
+#!/usr/bin/env racket
+#lang cli
+
+(require qi
+         qi/probe)
+
+(require relation
+         json
+         racket/format
+         racket/port)
+
+(define LOWER-THRESHOLD 0.75)
+(define HIGHER-THRESHOLD 1.5)
+
+(define (parse-json-file filename)
+  (call-with-input-file filename
+    (λ (port)
+      (read-json port))))
+
+(define (parse-benchmarks filename)
+  (make-hash
+   (map (☯ (~> (-< (~> (hash-ref 'name)
+                       (switch
+                         [(equal? "foldr") "<<"] ; these were renamed at some point
+                         [(equal? "foldl") ">>"] ; so rename them back to match them
+                         [else _]))
+                   (hash-ref 'value))
+               cons))
+        (parse-json-file filename))))
+
+(help
+ (usage (~a "Report relative performance of forms between two sets of results\n"
+            "(e.g. run against two different commits).")))
+
+(program (main [before-file "'before' file"]
+               [after-file "'after' file"])
+  ;; before and after are expected to be JSON-formatted, as
+  ;; generated by report.rkt (e.g. via `make benchmarks-report`)
+  (define before (parse-benchmarks before-file))
+  (define after (parse-benchmarks after-file))
+
+  (define-flow calculate-ratio
+    (~> (-< (hash-ref after _)
+            (hash-ref before _))
+        /
+        (if (< LOWER-THRESHOLD _ HIGHER-THRESHOLD)
+            1
+            (~r #:precision 2))))
+
+  (define results
+    (~>> (before)
+         hash-keys
+         △
+         (><
+          (~>
+           (-< _
+               calculate-ratio)
+           ▽))
+         ▽
+         (sort > #:key (☯ (~> cadr ->inexact)))))
+  (println results))
+
+(run main)

qi-sdk/profile/report.rkt

@@ -1,3 +1,4 @@
+#!/usr/bin/env racket
 #lang cli
 
 (require
@@ -70,6 +71,7 @@
          relation
          qi
          json
+         csv-writing
          (only-in "util.rkt"
                   only-if
                   for/call))
@@ -144,15 +146,41 @@
    "apply" apply:run
    "clos" clos:run))
 
+(define (write-csv data)
+  (~> (data)
+      △
+      (>< (~> (-< (hash-ref 'name)
+                  (hash-ref 'unit)
+                  (hash-ref 'value))
+              ▽))
+      (-< '(name unit value)
+          _)
+      ▽
+      display-table))
+
+(help
+ (usage (~a "Report on the performance of all of the forms "
+            "of the language, in a configurable output format.")))
+
+(flag (output-format #:param [output-format "json"] fmt)
+  ("-f" "--format" "Output format to use, either 'json' or 'csv'")
+  (output-format fmt))
+
 (program (main)
-  ;; TODO: could use try-order? with hash-keys if support is dropped for Racket 8.3
-  (define fs (~>> (env) hash-keys (sort <)))
+  (define fs (hash-keys env #t))
   (define forms-data (for/list ([f (in-list fs)])
                        (match-let ([(list name ms) ((hash-ref env f))])
                          (hash 'name name 'unit "ms" 'value ms))))
   (define require-data (list (hash 'name "(require qi)"
                                    'unit "ms"
                                    'value (time-module-ms "qi"))))
-  (write-json (append forms-data require-data)))
+  (let ([output (append forms-data require-data)])
+    ;; Note: this is a case where declaring "constraints" on the CLI args
+    ;; would be useful, instead of using the ad hoc fallback `else` check here
+    ;; https://github.com/countvajhula/cli/issues/6
+    (cond
+      [(equal? (output-format) "json") (write-json output)]
+      [(equal? (output-format) "csv") (write-csv output)]
+      [else (error (~a "Unrecognized format: " (output-format) "!"))])))
 
 (run main)