|
| 1 | +(ns orchard.profile |
| 2 | + "Very simplistic manual tracing profiler for individual functions." |
| 3 | + {:author "Oleksandr Yakushev" |
| 4 | + :added "0.33"} |
| 5 | + (:require [orchard.misc :as misc]) |
| 6 | + (:import java.util.concurrent.locks.ReentrantLock |
| 7 | + java.util.Arrays)) |
| 8 | + |
| 9 | +;; The profiler works like following: for each profiled function, an entry in |
| 10 | +;; `collected-timings` atom is created. Timings are stored as an array. Inside |
| 11 | +;; each array, the first cell stores how many samples we have accumulated so |
| 12 | +;; far. When the array becomes full, we grow it 2x until `max-sample-count` is |
| 13 | +;; reached. At that point, new sample just overwrites a random old sample. The |
| 14 | +;; mutable arrays are protected by a global `data-lock`. |
| 15 | + |
| 16 | +(def ^:private ^:const max-sample-count (int (Math/pow 2 17))) |
| 17 | +(def ^:private data-lock (ReentrantLock.)) |
| 18 | +(def ^:private collected-timings (atom {})) |
| 19 | + |
| 20 | +(defn- assoc-and-get-array [k array] |
| 21 | + (get (swap! collected-timings assoc k array) k)) |
| 22 | + |
| 23 | +(defn- record-timing [k, ^long nanos] |
| 24 | + (misc/with-lock data-lock |
| 25 | + (let [^longs arr (or (get @collected-timings k) |
| 26 | + ;; Initial array is 256 items long (1KB). |
| 27 | + (assoc-and-get-array k (long-array 256))) |
| 28 | + alen (alength arr) |
| 29 | + n (aget arr 0) ;; First cell array stores number of samples. |
| 30 | + i (inc n) |
| 31 | + ;; Check if we've run out of free space in the array and still under |
| 32 | + ;; the max-sample-count. If so, grow the array. |
| 33 | + ^longs arr (if (and (>= i alen) (< alen max-sample-count)) |
| 34 | + (assoc-and-get-array k (Arrays/copyOf arr (* alen 2))) |
| 35 | + arr) |
| 36 | + alen (alength arr)] |
| 37 | + (aset arr 0 i) |
| 38 | + (if (< i alen) |
| 39 | + (aset arr i nanos) |
| 40 | + ;; We're out of space and the array can't grow anymore, so we just write |
| 41 | + ;; to a random position. |
| 42 | + (aset arr (inc (rand-int (dec alen))) nanos))))) |
| 43 | + |
| 44 | +(defn- resolve-var ^clojure.lang.Var [v] |
| 45 | + (if (var? v) v (resolve v))) |
| 46 | + |
| 47 | +(defn- wrap-profiled [var raw-fn] |
| 48 | + (fn profiling-wrapper [& args] |
| 49 | + (let [nano-now (System/nanoTime) |
| 50 | + val (apply raw-fn args) |
| 51 | + elapsed (- (System/nanoTime) nano-now)] |
| 52 | + (record-timing var elapsed) |
| 53 | + val))) |
| 54 | + |
| 55 | +;;;; Calculations |
| 56 | + |
| 57 | +(defn- standard-deviation [^longs arr, ^double mean] |
| 58 | + (let [sum (areduce arr i sum 0.0 (+ sum (Math/pow (- mean (aget arr i)) 2.0)))] |
| 59 | + (Math/sqrt (/ sum (max (dec (alength arr)) 1))))) |
| 60 | + |
| 61 | +(defn- entry-stats [var, ^longs samples] |
| 62 | + (let [count (aget samples 0) |
| 63 | + n (min (dec (alength samples)) count) |
| 64 | + sorted (doto (Arrays/copyOfRange samples 1 (inc n)) Arrays/sort) |
| 65 | + sum (areduce sorted i sum 0 (+ sum (aget sorted i))) |
| 66 | + mean (double (/ sum n))] |
| 67 | + (array-map ;; Using array-map to enforce key order. |
| 68 | + :name var |
| 69 | + :n count |
| 70 | + :mean mean |
| 71 | + :std (standard-deviation sorted mean) |
| 72 | + :sum sum |
| 73 | + :min (aget sorted 0) |
| 74 | + :max (aget sorted (dec n)) |
| 75 | + :med (aget sorted (int (/ n 2))) |
| 76 | + :samples (vec sorted)))) |
| 77 | + |
| 78 | +(defn- format-duration [nanos] |
| 79 | + (cond (> nanos 1e9) (format "%.1f s" (/ nanos 1e9)) |
| 80 | + (> nanos 1e6) (format "%.0f ms" (/ nanos 1e6)) |
| 81 | + (> nanos 1e3) (format "%.0f us" (/ nanos 1e3)) |
| 82 | + :else (format "%.0f ns" (double nanos)))) |
| 83 | + |
| 84 | +(defn- format-stats-for-inspector [stats-map] |
| 85 | + ;; Prettify results: attach units to timings, convert strings to symbols to |
| 86 | + ;; avoid quotes when this data will be displayed in the inspector. |
| 87 | + (-> (reduce #(update %1 %2 (comp symbol format-duration)) stats-map |
| 88 | + [:mean :sum :min :max :med]) |
| 89 | + (update :std #(symbol (str "±" (format-duration %)))))) |
| 90 | + |
| 91 | +;;;; Public API |
| 92 | + |
| 93 | +(def ^:private profiled-vars (atom #{})) |
| 94 | +(def ^:private profiled-nses (atom #{})) |
| 95 | + |
| 96 | +(defn profilable? |
| 97 | + "Return true if `v` contains a profilable function." |
| 98 | + [v] |
| 99 | + (let [v (resolve-var v)] |
| 100 | + (and (ifn? @v) (not (:macro (meta v)))))) |
| 101 | + |
| 102 | +(defn profiled? |
| 103 | + "Return true if `v` is already profiled." |
| 104 | + [v] |
| 105 | + (let [v (resolve-var v)] |
| 106 | + (contains? (meta v) ::profiled))) |
| 107 | + |
| 108 | +(defn profile-var |
| 109 | + "If the specified Var holds a function, its contents is replaced with a version |
| 110 | + wrapped in a profiling call. Can be undone with `unprofile-var`." |
| 111 | + [v] |
| 112 | + (let [v (resolve-var v)] |
| 113 | + (when (and (profilable? v) (not (profiled? v))) |
| 114 | + (let [raw-fn @v] |
| 115 | + (swap! profiled-vars conj v) |
| 116 | + (alter-var-root v #(wrap-profiled v %)) |
| 117 | + (alter-meta! v assoc ::profiled raw-fn) |
| 118 | + v)))) |
| 119 | + |
| 120 | +(defn unprofile-var |
| 121 | + "Reverses the effect of `profile-var` for the given Var, replacing the profiled |
| 122 | + function with the original version." |
| 123 | + [v] |
| 124 | + (let [v (resolve-var v) |
| 125 | + f (::profiled (meta v))] |
| 126 | + (when f |
| 127 | + (alter-var-root v (constantly (::profiled (meta v)))) |
| 128 | + (alter-meta! v dissoc ::profiled) |
| 129 | + (swap! profiled-vars disj v) |
| 130 | + v))) |
| 131 | + |
| 132 | +(defn profile-ns |
| 133 | + "Profile all Vars in the given namespace. Can be undone with `unprofile-ns`." |
| 134 | + [ns] |
| 135 | + (let [ns (the-ns ns)] |
| 136 | + (when-not ('#{clojure.core orchard.profile} (.name ns)) |
| 137 | + (->> (ns-interns ns) |
| 138 | + vals |
| 139 | + (filter (comp fn? var-get)) |
| 140 | + (run! profile-var)) |
| 141 | + (swap! profiled-nses conj ns)))) |
| 142 | + |
| 143 | +(defn unprofile-ns |
| 144 | + "Unprofile all Vars in the given namespace." |
| 145 | + [ns] |
| 146 | + (let [ns (the-ns ns)] |
| 147 | + (->> (ns-interns ns) |
| 148 | + vals |
| 149 | + (filter (comp fn? var-get)) |
| 150 | + (run! unprofile-var)) |
| 151 | + (swap! profiled-nses disj ns))) |
| 152 | + |
| 153 | +(defn toggle-profile-ns |
| 154 | + "Profile vars in the given namespace if it's not profiled yet, otherwise undo |
| 155 | + the profiling. Return true if profiling did happen." |
| 156 | + [ns] |
| 157 | + (let [ns (the-ns ns)] |
| 158 | + (if (contains? @profiled-nses ns) |
| 159 | + (do (unprofile-ns ns) |
| 160 | + false) |
| 161 | + (do (profile-ns ns) |
| 162 | + true)))) |
| 163 | + |
| 164 | +(defn unprofile-all |
| 165 | + "Reverses the effect of profiling for all already profiled vars and namespaces." |
| 166 | + [] |
| 167 | + (run! unprofile-ns @profiled-nses) |
| 168 | + (run! unprofile-var @profiled-vars)) |
| 169 | + |
| 170 | +(defn summary |
| 171 | + "Returns a map where keys are the profiled function vars, and values are maps |
| 172 | + with the profiling stats." |
| 173 | + [] |
| 174 | + (misc/with-lock data-lock |
| 175 | + (into {} (map (fn [[var samples]] [var (entry-stats var samples)])) |
| 176 | + @collected-timings))) |
| 177 | + |
| 178 | +(defn summary-for-inspector |
| 179 | + "Return profiling results as a list of stats maps, optimized to be viewed with |
| 180 | + `orchard.inspect`." |
| 181 | + [] |
| 182 | + (sort-by #(str (:name %)) (vals (misc/update-vals format-stats-for-inspector (summary))))) |
| 183 | + |
| 184 | +(defn clear |
| 185 | + "Clears all profiling results." |
| 186 | + [] |
| 187 | + (misc/with-lock data-lock |
| 188 | + (reset! collected-timings {}))) |
0 commit comments