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.
 |#

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

[defn bench/get-language-runtimes [language]
  [case language
    [:common-lisp '["ecl --shell" "clisp"]]
    [:dart '["dart"]]
    [:erlang '["escript"]]
    [:janet '["janet"]]
    [:javascript '["node" "qjs" "deno run"]]
    [:kuroko '["kuroko"]]
    [:lua '["lua" "luajit"]]
    [:nujel '["nujel"]]
    [:perl '["perl"]]
    [:php '["php"]]
    [:python '["python" "pypy"]]
    [:racket '["racket"]]
    [:ruby '["ruby"]]
    [:scheme '["guile" "chibi-scheme -q" "gosh" "chez --script" "tinyscheme" "s9"]]
    ;[:scheme '["guile" "chibi-scheme -q" "gosh" "chez --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\""]]
    ;["tinyscheme" [popen/trim "bash -c \"tinyscheme -? 2>&1\""]]
    ;["s9" [popen/trim "bash -c \"s9 -? 2>&1\""]]
    ["deno" [popen/trim "bash -c \"deno --version 2>&1\""]]
    ["qjs" [popen/trim "bash -c \"qjs -h 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"]
    [otherwise "fmg90asrkj0jrs0fgwa09res"]]]

[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 "{} {} "
                    [ansi-blue [string/pad-end language 14]]
                    [ansi-red [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 [file/temp ""]]
  [def measurements #nil]
  [def testcase [cadr [split filename "/"]]]
  [try [fn [err]
           [file/remove result-file]
           [display/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]]]]
       [file/remove result-file]]
  [when-not measurements [return #nil]]
  [-> measurements
      [tree/set! :language [bench/get-language filename]]
      [tree/set! :stdout [cdr ret]]
      [tree/set! :git-head [popen/trim "git rev-parse HEAD"]]
      [tree/set! :git-branch [popen/trim "git rev-parse --abbrev-ref HEAD"]]
      [tree/set! :uname [popen/trim "uname -a"]]
      [tree/set! :architecture [popen/trim "uname -m"]]
      [tree/set! :time [time]]
      [tree/set! :testcase testcase]
      [tree/set! :total [+ [ref measurements :user] [ref measurements :system]]]
      [tree/set! :date [popen/trim "date -Iseconds"]] ; Would be nice if this could be done as easily in Nujel
      [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]]
  [for-in [runtime [bench/get-language-runtimes language]]
          [when-not runtime [return ret]]
          [for [i 0 4]
               [set! ret [cons [bench/single filename runtime i] ret]]]
          [println ""]]
  ret]

[def res-name [cat [popen/trim "date -I"] "-" [popen/trim "uname -n"] "-" [popen/trim "git rev-parse HEAD"]]]
[directory/make "web/benchmark-results"]
[-> [directory/read-recursive "benchmark"]
    [reduce bench/file #nil]
    [val->json]
    [file/write [fmt "web/benchmark-results/{}.json" res-name]]]