#^:shebang '[

exec java -cp "$HOME/.m2/repository/org/clojure/clojure/1.7.0/clojure-1.7.0.jar" clojure.main "$0" "$@"

]

"USAGE: ./bench [-c | -f] (jvm|js) (<bench-name>|all) (<tag>|<revision>)"

(require

'[clojure.edn :as edn]

'[clojure.java.io :as io]

'[clojure.java.shell :as sh]

'[clojure.string :as str])

(defn sh [& cmd]

(let [res (apply sh/sh cmd)]

(when (not= 0 (:exit res))

(throw (ex-info "ERROR" res)))

(str/trim (:out res))))

(defn copy [^java.io.InputStream input ^java.io.Writer output]

(let [^"[C" buffer (make-array Character/TYPE 1024)

in (java.io.InputStreamReader. input "UTF-8")

w (java.io.StringWriter.)]

(loop []

(let [size (.read in buffer 0 (alength buffer))]

(if (pos? size)

(do (.write output buffer 0 size)

(.flush output)

(.write w buffer 0 size)

(recur))

(str w))))))

(defn run [& cmd]

(let [cmd (remove nil? cmd)

proc (.exec (Runtime/getRuntime)

(into-array String cmd)

(@#'sh/as-env-strings sh/*sh-env*)

(io/as-file sh/*sh-dir*))

out (promise)]

(with-open [stdout (.getInputStream proc)

stderr (.getErrorStream proc)]

(future (deliver out (copy stdout *out*)))

(future (copy stderr *err*))

(.close (.getOutputStream proc))

(let [code (.waitFor proc)]

(when (not= code 0)

(throw (ex-info "ERROR" {:cmd cmd :code code})))

@out))))

(defn build [ref]

(let [commit-count (sh "git" "rev-list" ref "--count")

sha1 (sh "git" "rev-parse" ref)

descr (sh "git" "describe" ref "--tags")]

(str commit-count "/" (subs sha1 0 7) "/" (str/replace descr #"-g.+" ""))))

(def opts

(loop [opts {:clean false

:fast false

:project "jvm"

:bench "all"

:ref nil}

args *command-line-args*]

(if-let [arg (first args)]

(cond

(#{"-c" "-clean" "--clean"} arg)

(recur (assoc opts :clean true) (next args))

(#{"-f" "-fast" "--fast"} arg)

(recur (assoc opts :fast true) (next args))

(#{"jvm" "js" "datomic"} arg)

(recur (assoc opts :project arg) (next args))

(#{"db_with" "init_db" "queries" "predicates" "rules" "btset"} arg)

(recur (assoc opts :bench arg) (next args))

(re-matches #"[0-9.\-]+" arg)

(recur (assoc opts :ref arg) (next args))

:else

(throw (ex-info "Unknown option: " {:arg arg :args *command-line-args*})))

opts)))

(def clean? (:clean opts))

(def skip-build? (:fast opts))

(def project (get {"jvm" "datascript-jvm"

"js" "datascript-v8"

"datomic" "datomic-mem"}

(:project opts)))

(def datomic? (= "datomic-mem" project))

(def bench (:bench opts))

(def rfrnc (if datomic?

(or (:ref opts) "0.9.5173")

(:ref opts)))

(def dir (if rfrnc "." ".."))

(def rdir (if rfrnc "." "./bench"))

(def env (merge

{ "BENCH_PROJECT" project

"BENCH_BUILD" (if datomic?

rfrnc

(build (or rfrnc "HEAD"))) }

(if datomic?

{"DATOMIC_VERSION" rfrnc}

(when rfrnc

{"BENCH_VERSION" (sh "git" "describe" rfrnc "--tags")}))))

(println "Running" bench "within" env "...")

(defn run-bench []

(case project

"datascript-jvm"

(run "lein" "trampoline" "run" "-m" (str "datascript.bench/bench-" bench))

"datascript-v8"

(do

(when-not skip-build?

(run "lein" "cljsbuild" "once" "advanced"))

(run "node" (str rdir "/run_v8.js") bench (str dir "/target/datascript.js")))

"datomic-mem"

(run "lein" "trampoline" "run" "-m" (str "datascript.bench-datomic/bench-" bench))))

(defn read-all [reader]

(loop [acc []]

(if-let [obj (edn/read {:eof nil} reader)]

(recur (conj acc obj))

acc)))

(defn pp-result [res]

(println "{ :context" (pr-str (:context res))

"\n :spec " (pr-str (:spec res))

"\n :env " (pr-str (:env res))

"\n :results" (pr-str (:results res)) "}"))

(defn merge-results [new]

(let [old (with-open [in0 (io/reader "results.edn")

in (java.io.PushbackReader. in0)]

(read-all in))

new (read-all (java.io.PushbackReader. (java.io.StringReader. new)))

key-fn (juxt :context :spec)

new-keys (into #{} (map key-fn) new)

filtered (remove #(contains? new-keys (key-fn %)) old)

merged (concat filtered new)]

(with-open [out (io/writer "results.edn")]

(binding [*out* out]

(doseq [r merged]

(pp-result r))))))

(binding [sh/*sh-env* (merge {} (System/getenv) env)

sh/*sh-dir* dir]

(when clean?

(run "lein" "clean"))

(let [out (run-bench)]

(when-not skip-build?

(merge-results out))))

(System/exit 0)