Ben / Nujel

#!/usr/bin/env nujel
#| This script generates JSON files to be used with the web-based benchmark viewer,
| any sort of analysis is deferred to the browser, here we just measure the date
| and capture as much data as possible. After a run a new file will be added to
| benchmarks/results/, which should then be uploaded to the server which can then
| use the benchmark-aggregate.nuj script to generate the single aggregate JSON
| file for the viewer.
|#

[import [serialize :as val->json] :serialization/json]

[def single-runs 4]
[def nujel-runs  4]
[def git-head [popen/trim "git rev-parse HEAD"]]
[def git-branch [popen/trim "git rev-parse --abbrev-ref HEAD"]]
[def uname-a [popen/trim "uname -a"]]
[def date [popen/trim "git show -s --format=%cI"]] ; Would be nice if this could be done as easily in Nujel
[def rough-date [popen/trim "git show -s --format=%cs"]]
[def hostname [popen/trim "uname -n"]]

[defn bench/get-language [filename]
      [case [lowercase [path/extension filename]]
            ["lisp" :common-lisp]
            ["newlisp" :newlisp]
            ["el" :emacs-lisp]
            ["c" :c]
            ["dart" :dart]
            ["erl" :erlang]
            ["jnt" :janet]
            ["js" :javascript]
            ["krk" :kuroko]
            ["lua" :lua]
            ["jl" :julia]
            ["nuj" :nujel]
            ["pl" :perl]
            ["php" :php]
            ["py" :python]
            ["rkt" :racket]
            ["zuo" :zuo]
            ["rby" :ruby]
            ["scm" :scheme]
            [otherwise #nil]]]

[defn bench/get-language-runtimes [language]
      [case language
            [:c '["tcc -run"]]
            [:common-lisp '["ecl --shell" "clisp" "sbcl --script"]]
            [:newlisp '["newlisp"]]
            [:emacs-lisp '["emacs -Q --script"]]
            [:dart '["dart"]]
            [:erlang '["escript"]]
            [:janet '["janet"]]
            [:javascript '["node" "qjs" "deno run" "duk" "mujs" "js78" "js91" "bun"]]
            [:kuroko '["kuroko"]]
            [:lua '["lua" "luajit" "luau"]]
            [:julia '["julia"]]
            [:nujel '["./nujel"]]
            [:perl '["perl"]]
            [:php '["php"]]
            [:python '["python" "pypy"]]
            [:racket '["racket"]]
            [:zuo '["zuo"]]
            [:ruby '["ruby" "mruby"]]
            [:scheme '["guile" "stklos -f" "chibi-scheme -q" "gosh" "chez --script" "scheme48" "mit-scheme-script"]]
            [otherwise '[]]]]

[defn bench/get-runtime-version [runtime]
      [case [car [split runtime " "]]
            ["clisp" [popen/trim "bash -c \"clisp -q -norc --version 2>/dev/null\""]]
            ["ecl" [popen/trim "bash -c \"ecl --version 2>&1\""]]
            ["s9" [popen/trim "bash -c \"s9 -? 2>&1 | head -n 2\""]]
            ["deno" [popen/trim "bash -c \"deno --version 2>&1\""]]
            ["qjs" [popen/trim "bash -c \"qjs -h 2>&1\""]]
            ["newlisp" [popen/trim "bash -c \"newlisp -v 2>&1\""]]
            ["kuroko" [popen/trim "bash -c \"kuroko --version 2>&1\""]]
            ["escript" [popen/trim "bash -c \"erl -version 2>&1\""]]
            ["node" [popen/trim "bash -c \"node --version 2>&1\""]]
            [["lua" "luajit"] [popen/trim [fmt "bash -c \"{runtime} -v 2>&1\""]]]
            ["perl" [popen/trim "bash -c \"perl --version 2>&1\""]]
            ["php" [popen/trim "bash -c \"php --version 2>&1\""]]
            ["python" [popen/trim "bash -c \"python --version 2>&1\""]]
            ["pypy" [popen/trim "bash -c \"pypy --version 2>&1\""]]
            ["racket" [popen/trim "bash -c \"racket --version 2>&1\""]]
            ["ruby" [popen/trim "bash -c \"ruby --version 2>&1\""]]
            ["guile" [popen/trim "bash -c \"guile --version 2>&1\""]]
            ["chibi-scheme" [popen/trim "bash -c \"chibi-scheme --version 2>&1\""]]
            ["gosh" [popen/trim "bash -c \"gosh -V 2>&1\""]]
            [otherwise [fmt "{runtime}-unknown"]]]]

[defn runtime/available? [runtime]
      [def executable [car [split runtime " "]]]
      [zero? [car [popen [fmt "command -v {executable}"]]]]]

[defn get-result [testcase]
      [case testcase
            ["for" "49999995000000"]
            ["hello" "Hello"]
            ["euler1" "23333331666668"]
            ["euler4" "906609"]
            [otherwise "チーズスイートホーム"]]]

[def time-template "#@[:user %U :system %S :elapsed \\\"%E\\\" :cpu \\\"%P\\\" :text %X :data %D :max-resident %M :inputs %I :outputs %O :pagefaults-major %F :pagefaults-minor %R :swaps %W]"]
[defn bench/single [filename runtime i]
      [def language [bench/get-language filename]]
      [when-not [runtime/available? runtime]
                [when [zero? i]
                      [pfmt "{} {} Runtime not found"
                            [ansi-blue [string/pad-end language 14]]
                            [ansi-yellow [string/pad-end runtime 20]]]]
                [return #nil]]
      [when [zero? i]
            [pfmt "{} {} "
                  [ansi-blue [string/pad-end language 14]]
                  [ansi-green [string/pad-end runtime 20]]]]
      [pfmt "{i} "]
      [when-not [file/file? filename]
                [exception :io-error "Can't open the following file to benchmark it:" filename]]
      [def result-file "nujel-benchmark.tmp"]
      [def measurements #nil]
      [def testcase [cadr [split filename "/"]]]
      [try [fn [err]
               [file/remove result-file]
             [print/error err]
             [throw err]]
           [def ret [popen [fmt "time -o {result-file} --format=\"{time-template}\" {runtime} {filename}"]]]
           [when-not [zero? [car ret]]
                     [exception :benchmark-error "Benchmark returned non-zero exit code" [cons filename ret]]]
           [when-not [>= [index-of [cdr ret] [get-result testcase]] 0]
                     [exception :benchmark-error "Benchmark returned wrong result" [cons filename ret]]]
           [set! measurements [tree/dup [read/single [file/read result-file]]]]
           [tree/set! measurements :stdout [cdr ret]]
           [file/remove result-file]]
      [when-not measurements [return #nil]]
      [-> measurements
          [tree/set! :language [bench/get-language filename]]
          [tree/set! :git-head git-head]
          [tree/set! :git-branch git-branch]
          [tree/set! :uname uname-a]
          [tree/set! :architecture System/Architecture]
          [tree/set! :hostname hostname]
          [tree/set! :os System/OS]
          [tree/set! :time [time]]
          [tree/set! :triplet [fmt "{testcase}-{hostname}-{System/Architecture}"]]
          [tree/set! :testcase testcase]
          [tree/set! :total [+ [ref measurements :user] [ref measurements :system]]]
          [tree/set! :date date]
          [tree/set! :runtime runtime]
          [tree/set! :runtime-version [bench/get-runtime-version runtime]]
          [tree/set! :filename filename]]]

[defn bench/file [ret filename]
      [when-not filename [return ret]]
      [def language [bench/get-language filename]]
      [and [tree/has? repl/options :only-nujel]
           [not= language :nujel]
           [return ret]]
      [def cur-runs [if [= language :nujel]
                        nujel-runs
                        single-runs]]
      [doseq [runtime [bench/get-language-runtimes language]]
             [when-not runtime [return ret]]
             [when [> cur-runs 0]
                   [dotimes [i cur-runs]
                            [set! ret [cons [bench/single filename runtime i] ret]]]
                   [popen "sleep 10"]
                   [println ""]]]
      ret]

[def res-name [fmt "{rough-date}-{hostname}-{git-head}"]]
[def out-name [fmt "web/benchmark-results/{}.json" res-name]]
[directory/make "web/benchmark-results"]

[and [tree/has? repl/options :no-overwrite]
     [file/file? out-name]
     [do [pfmtln "{out-name} exists already, exiting."]
         [exit 0]]]

[-> [directory/read-recursive "benchmark"]
    [sort]
    [reduce bench/file #nil]
    [val->json]
    [file/write out-name]]