├── LICENSE ├── README.mess ├── docs └── index.html ├── documentation.lisp ├── package.lisp ├── sampler.lisp ├── timer.lisp ├── toolkit.lisp └── trivial-benchmark.asd /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2024 Yukari Hafner 2 | 3 | This software is provided 'as-is', without any express or implied 4 | warranty. In no event will the authors be held liable for any damages 5 | arising from the use of this software. 6 | 7 | Permission is granted to anyone to use this software for any purpose, 8 | including commercial applications, and to alter it and redistribute it 9 | freely, subject to the following restrictions: 10 | 11 | 1. The origin of this software must not be misrepresented; you must not 12 | claim that you wrote the original software. If you use this software 13 | in a product, an acknowledgment in the product documentation would be 14 | appreciated but is not required. 15 | 2. Altered source versions must be plainly marked as such, and must not be 16 | misrepresented as being the original software. 17 | 3. This notice may not be removed or altered from any source distribution. 18 | -------------------------------------------------------------------------------- /README.mess: -------------------------------------------------------------------------------- 1 | # About Trivial-Benchmark 2 | Frequently I want to do a quick benchmark comparison of my functions. ``time`` is nice to get some data, but it's limited to a single run so there isn't really much of a statistical value in it. Trivial-Benchmark runs a block of code many times and outputs some statistical data for it. On SBCL this includes the data from ``time``, for all other implementations just the REAL- and RUN-TIME data. 3 | 4 | # How-To 5 | We assume that there's a local or global nickname for ``org.shirakumo.trivial-benchmark`` called ``tb``. You can activate the global nickname with ``(org.shirakumo.trivial-benchmark:add-nickname)``. 6 | 7 | For basic throwaway benchmarking, the ``with-timing`` macro should suffice: 8 | 9 | :: common lisp 10 | (tb:with-timing (1000) 11 | (+ 1 1)) 12 | :: 13 | 14 | However, you can also do more complex timing using your own ``timer`` and ``with-sampling``. The former creates a new timer object (with an optional list of metrics to sample) and the latter collects one sample for each metric of the timer for the duration of the body forms. 15 | 16 | :: common lisp 17 | (defvar *timer* (make-instance 'tb:timer)) 18 | 19 | (tb:with-sampling (*timer*) 20 | (+ 1 1)) 21 | 22 | (tb:with-sampling (*timer*) 23 | (expt 10 100)) 24 | 25 | (tb:report *timer*) 26 | 27 | (tb:reset *timer*) 28 | 29 | (tb:report *timer*) 30 | :: 31 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | Trivial Benchmark

trivial benchmark

3.0.0

An easy to use benchmarking system.

About Trivial-Benchmark

Frequently I want to do a quick benchmark comparison of my functions. time is nice to get some data, but it's limited to a single run so there isn't really much of a statistical value in it. Trivial-Benchmark runs a block of code many times and outputs some statistical data for it. On SBCL this includes the data from time, for all other implementations just the REAL- and RUN-TIME data.

How-To

We assume that there's a local or global nickname for org.shirakumo.trivial-benchmark called tb. You can activate the global nickname with (org.shirakumo.trivial-benchmark:add-nickname).

For basic throwaway benchmarking, the with-timing macro should suffice:

(tb:with-timing (1000)
  2 |   (+ 1 1))

However, you can also do more complex timing using your own timer and with-sampling. The former creates a new timer object (with an optional list of metrics to sample) and the latter collects one sample for each metric of the timer for the duration of the body forms.

(defvar *timer* (make-instance 'tb:timer))
  3 | 
  4 | (tb:with-sampling (*timer*)
  5 |   (+ 1 1))
  6 | 
  7 | (tb:with-sampling (*timer*)
  8 |   (expt 10 100))
  9 | 
 10 | (tb:report *timer*)
 11 | 
 12 | (tb:reset *timer*)
 13 | 
 14 | (tb:report *timer*)

System Information

3.0.0
Yukari Hafner
zlib

Definition Index

-------------------------------------------------------------------------------- /documentation.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.trivial-benchmark) 2 | 3 | ;; toolkit.lisp 4 | (docs:define-docs 5 | (function print-table 6 | "Print a table of values 7 | 8 | TABLE should be a list of lists in row-major order. Each row must have 9 | the same number of elements. 10 | 11 | STREAM is the stream to print the table to. 12 | 13 | PADDING is the amount of space to insert to the left and right of 14 | every cell. 15 | 16 | FORMAT is the format to print the table in. Can be one of: 17 | :PRINC --- justs PRINCs the table instead 18 | :MINIMAL --- prints the table as small as it can 19 | :FANCY --- prints the table with box drawing glyphs") 20 | 21 | (function add-nickname 22 | "Adds the nikcnames TRIVIAL-BENCHMARK and TB to the package. 23 | 24 | This is for convenience.")) 25 | 26 | ;; sampler.lisp 27 | (docs:define-docs 28 | (variable *default-samplers* 29 | "Which sampler types to use by default. 30 | 31 | See SAMPLER 32 | See WITH-SAMPLING") 33 | 34 | (type sampler 35 | "Representation of a sample measuring method. 36 | 37 | See VARIABLES 38 | See WRAP-MEASUREMENT-FORM 39 | See COMMIT-SAMPLES-FORM 40 | See DEFINE-SAMPLER 41 | See WITH-SAMPLING") 42 | 43 | (function variables 44 | "Return a list of variable specs the sampler needs. 45 | 46 | Each variable spec should be a list of the following elements: 47 | SYMBOL --- The symbol the variable is bound to 48 | DEFAULT --- The default value the variable is initialised to 49 | TYPE --- The type to declare the variable as 50 | 51 | See WITH-SAMPLING 52 | See SAMPLER (type)") 53 | 54 | (function wrap-measurement-form 55 | "Wrap FORM in a form to record sampling data. 56 | 57 | Returns the new form. 58 | The returned form is emitted into a lexical environment where 59 | variables according to the SAMPLER's VARIBALES specs are bound. 60 | 61 | See WITH-SAMPLING 62 | See SAMPLER (type)") 63 | 64 | (function commit-samples-form 65 | "Emit a form to commit measured samples 66 | 67 | Returns a new form. 68 | The returned form is emitted into a lexical environment where 69 | COMMIT-FN is bound to a macro with the following behaviour: 70 | 71 | (commit-fn metric sample ...) 72 | 73 | Each pair of METRIC and SAMPLE are recorded in the timer 74 | METRIC should be a symbol naming the metric to store the sample 75 | under, and SAMPLE should be a REAL number to record. The sample is 76 | coerced to a DOUBLE-FLOAT automatically. 77 | 78 | See WITH-SAMPLING 79 | See SAMPLER (type)") 80 | 81 | (function define-sampler 82 | "Convenience macro to define a new sampler type. 83 | 84 | NAME should be the name of the new sampler class. 85 | VARS should be a list of variable specs that the sampler will use to 86 | store data during a sampling step. Each spec can be either a symbol 87 | naming the variable, or a variable spec list. 88 | FORMS should match the following structures: 89 | 90 | (:MEASURE (FORM-VAR) BODY...) 91 | (:COMMIT (COMMIT-FN-VAR) BODY...) 92 | 93 | Which are converted to methods for WRAP-MEASUREMENT-FORM and 94 | COMMIT-SAMPLES-FORM respectively. Every variable in VARS is bound 95 | during the body of either, so that you can conveniently emit it into 96 | the resulting forms. 97 | 98 | See VARIABLES 99 | See WRAP-MEASUREMENT-FORM 100 | See COMMIT-SAMPLES-FORM 101 | See SAMPLER (type) 102 | See DEFINE-DELTA-SAMPLER") 103 | 104 | (function define-delta-sampler 105 | "Convenience macro to define a sampler type with a single delta metric. 106 | 107 | NAME can either be the name of the sampler, or a list of the name and 108 | a normalisation factor by which the delta is divided to convert it to 109 | a proper sample point. 110 | 111 | SAMPLE-POINT-FORMS should be one or more forms whose ultimate return 112 | value evaluates to some REAL number. The forms are emitted *twice*, 113 | the first time before the execution to be measured, and the second 114 | time after. The sample is computed based on the difference of the two 115 | return values. 116 | 117 | See DEFINE-SAMPLER 118 | See SAMPLER (type)")) 119 | 120 | ;; timer.lisp 121 | (docs:define-docs 122 | (variable *default-computations* 123 | "Which computations to make by default. 124 | 125 | See COMPUTE") 126 | 127 | (variable *default-metrics* 128 | "Which metrics to include by default. 129 | 130 | If NIL, all sampled metrics are included. 131 | 132 | See FORMAT-TIMER-STATS") 133 | 134 | (function compute 135 | "Compute a derived statistic from a vector of samples. 136 | 137 | You may add additional methods to this, though the following 138 | computation types are provided by default: 139 | 140 | :COUNT 141 | :SAMPLES --- The number of samples 142 | :TOTAL --- The sum of all samples 143 | :MINIMUM --- The smallest sample 144 | :MAXIMUM --- The biggest sample 145 | :MEDIAN --- The median of all samples 146 | :AVERAGE --- The average of all samples 147 | :DEVIATION --- The standard deviation based on the average 148 | 149 | See *DEFAULT-COMPUTATIONS*") 150 | 151 | (function report-to 152 | "Print a report about THING to STREAM. 153 | 154 | STREAM may be a stream, T, or NIL, according to FORMAT's output 155 | designators. 156 | 157 | COMPUTATIONS may be a list of statistical properties to report on a 158 | vector of samples. 159 | 160 | Additional arguments are passed on to PRINT-TABLE 161 | 162 | See TIMER (type) 163 | See FORMAT-TIMER-STATS 164 | See PRINT-TABLE") 165 | 166 | (function samples 167 | "Accesses a sample vector for the given metric. 168 | 169 | The returned vector is adjustable and has a fill-pointer. 170 | If no vector for the given metric existed before, it is created for 171 | you. 172 | 173 | See TIMER (type)") 174 | 175 | (function metric-types 176 | "Returns a list of metric types included in the timer. 177 | 178 | See TIMER (type)") 179 | 180 | (function report 181 | "Prints a report on the given thing. 182 | 183 | This is a wrapper around REPORT-TO. 184 | 185 | See REPORT-TO") 186 | 187 | (type timer 188 | "Encompasses a set of samples. 189 | 190 | A timer can be re-used to sample in individual steps. 191 | 192 | See FORMAT-TIMER-STATS 193 | See SAMPLES 194 | See METRIC-TYPES 195 | See REPORT-TO 196 | See RESET 197 | See WITH-SAMPLING 198 | See WITH-TIMING") 199 | 200 | (function format-timer-stats 201 | "Print a table of the samples contained in the timer. 202 | 203 | STREAM should be a stream to print to. 204 | TIMER should be a TIMER instance. 205 | COMPUTATIONS should be the derived statistical properties to compute 206 | METRICS should be the metrics to include. If NIL, uses all metrics the 207 | timer recorded samples for. 208 | Other arguments are passed on to PRINT-TABLE 209 | 210 | See TIMER (type) 211 | See PRINT-TABLE 212 | See *DEFAULT-COMPUTATIONS* 213 | see *DEFAULT-METRICS*") 214 | 215 | (function reset 216 | "Resets the timer and clears all samples. 217 | 218 | See TIMER (type)") 219 | 220 | (function with-sampling 221 | "Records sampling information about FORMS into a timer. 222 | 223 | TIMER-FORM should evaluate to a TIMER instance, into which the 224 | sampling data will be committed. 225 | 226 | SAMPLERS should be a list of names of SAMPLER types that will measure 227 | the FORMS. If none are given, *DEFAULT-SAMPLERS* are used. 228 | 229 | The values of FORMS are returned. 230 | 231 | During expansion of this macro each sampler in SAMPLERS is 232 | instantiated and variable bindings according to their VARIABLES specs 233 | are emitted. Then, the FORMS are wrapped according to each sampler's 234 | WRAP-MEASUREMENT-FORM return value. The order here can matter, and the 235 | first sampler specified will be the \"innermost\" wrapper. Finally, 236 | each sampler's COMMIT-SAMPLES-FORM is emitted in order to record the 237 | sampling data into the timer. 238 | 239 | See *DEFAULT-SAMPLERS* 240 | See SAMPLER (type) 241 | See TIMER (type) 242 | See VARIABLES 243 | See WRAP-MEASUREMENT-FORM 244 | See COMMIT-SAMPLES-FORM") 245 | 246 | (function with-timing 247 | "Convenience macro to do a one-off timing. 248 | 249 | Creates a timer instance according to TIMER, runs WITH-SAMPLING N 250 | times, and then REPORTs the timer using the additional REPORT-ARGS. 251 | 252 | SAMPLERS argument is evaluated during compile time and can be a list 253 | or a name of a global variable holding a list of symbols. 254 | 255 | See TIMER (type) 256 | See WITH-SAMPLING 257 | See REPORT")) 258 | -------------------------------------------------------------------------------- /package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage #:org.shirakumo.trivial-benchmark 2 | (:use #:cl) 3 | ;; toolkit.lisp 4 | (:export 5 | #:print-table 6 | #:add-nickname) 7 | ;; sampler.lisp 8 | (:export 9 | #:*default-samplers* 10 | #:sampler 11 | #:variables 12 | #:wrap-measurement-form 13 | #:commit-samples-form 14 | #:define-sampler 15 | #:define-delta-sampler 16 | #:real-time 17 | #:run-time 18 | #:system-info 19 | #:gc-run-time 20 | #:bytes-consed 21 | #:eval-calls 22 | #:cycle-counter 23 | #:sb-time 24 | #:user-run-time 25 | #:system-run-time 26 | #:real-time 27 | #:gc-run-time 28 | #:gc-real-time 29 | #:processor-cycles 30 | #:eval-calls 31 | #:lambdas-converted 32 | #:page-faults 33 | #:bytes-consed) 34 | ;; timer.lisp 35 | (:export 36 | #:*default-computations* 37 | #:*default-metrics* 38 | #:compute 39 | #:report-to 40 | #:samples 41 | #:metric-types 42 | #:reset 43 | #:report 44 | #:timer 45 | #:format-timer-stats 46 | #:reset 47 | #:with-sampling 48 | #:with-timing)) 49 | 50 | -------------------------------------------------------------------------------- /sampler.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.trivial-benchmark) 2 | 3 | (defvar *default-samplers* ()) 4 | 5 | (defclass sampler () ()) 6 | (defgeneric variables (sampler)) 7 | (defgeneric wrap-measurement-form (sampler form)) 8 | (defgeneric commit-samples-form (sampler commit-fn)) 9 | 10 | (defun normalize-varspec (varspec) 11 | (destructuring-bind (name &optional (default 0) (type 'unsigned-byte)) (enlist varspec) 12 | (list (gensym (string name)) default type))) 13 | 14 | (defmacro define-sampler (name vars &body forms) 15 | `(progn 16 | (defclass ,name (sampler) 17 | ((variables :reader variables :initform 18 | (mapcar #'normalize-varspec ',vars)))) 19 | 20 | ,@(loop for (type args . body) in forms 21 | collect (ecase type 22 | (:measure 23 | `(defmethod wrap-measurement-form ((,name ,name) ,@args) 24 | (destructuring-bind ,(mapcar #'unlist vars) (mapcar #'unlist (variables ,name)) 25 | (declare (ignorable ,@(mapcar #'unlist vars))) 26 | ,@body))) 27 | (:commit 28 | `(defmethod commit-samples-form ((,name ,name) ,@args) 29 | (destructuring-bind ,(mapcar #'unlist vars) (mapcar #'unlist (variables ,name)) 30 | (declare (ignorable ,@(mapcar #'unlist vars))) 31 | ,@body))))))) 32 | 33 | (defmacro define-delta-sampler (name &body sample-point-forms) 34 | (destructuring-bind (name &optional (units 1)) (if (listp name) name (list name)) 35 | (let ((form `(progn ,@sample-point-forms))) 36 | `(define-sampler ,name (var) 37 | (:measure (form) 38 | (let ((start (gensym ,(format NIL "~a-~a" (string name) (string "START"))))) 39 | `(let ((,start ,',form)) 40 | (multiple-value-prog1 41 | ,form 42 | (setf ,var (- ,',form ,start)))))) 43 | (:commit (commit-fn) 44 | `(,commit-fn ,',name (/ (float ,var 0d0) ,',units))))))) 45 | 46 | (define-delta-sampler (real-time internal-time-units-per-second) 47 | (get-internal-real-time)) 48 | 49 | (define-delta-sampler (run-time internal-time-units-per-second) 50 | (get-internal-run-time)) 51 | 52 | #+sbcl 53 | (progn 54 | (define-sampler system-info (user-run-time system-run-time page-faults) 55 | (:measure (form) 56 | `(multiple-value-bind (a0 b0 c0) (sb-sys:get-system-info) 57 | (multiple-value-prog1 ,form 58 | (multiple-value-bind (a1 b1 c1) (sb-sys:get-system-info) 59 | (setf ,user-run-time (- a1 a0) 60 | ,system-run-time (- b1 b0) 61 | ,page-faults (- c1 c0)))))) 62 | (:commit (commit-fn) 63 | `(,commit-fn user-run-time (/ (float ,user-run-time 0d0) 1000000) 64 | system-run-time (/ (float ,system-run-time 0d0) 1000000) 65 | page-faults ,page-faults))) 66 | 67 | (define-delta-sampler (gc-run-time 1000) 68 | sb-ext:*gc-run-time*) 69 | 70 | (define-delta-sampler bytes-consed 71 | (sb-ext:get-bytes-consed)) 72 | 73 | (define-delta-sampler eval-calls 74 | sb-kernel:*eval-calls*) 75 | 76 | (define-sampler cycle-counter (h0 l0 h1 l1) 77 | (:measure (form) 78 | `(progn (multiple-value-setq (,h0 ,l0) (sb-impl::read-cycle-counter)) 79 | (multiple-value-prog1 ,form 80 | (multiple-value-setq (,h1 ,l1) (sb-impl::read-cycle-counter))))) 81 | (:commit (commit-fn) 82 | `(,commit-fn processor-cycles (sb-impl::elapsed-cycles ,h0 ,l0 ,h1 ,l1)))) 83 | 84 | (define-sampler sb-time (user-run-time-us 85 | system-run-time-us 86 | real-time-ms 87 | gc-run-time-ms 88 | gc-real-time-ms 89 | processor-cycles 90 | eval-calls 91 | lambdas-converted 92 | page-faults 93 | bytes-consed) 94 | (:measure (form) 95 | `(sb-ext:call-with-timing 96 | (lambda (&rest args) 97 | (setf ,user-run-time-us (getf args :user-run-time-us 0) 98 | ,system-run-time-us (getf args :system-run-time-us 0) 99 | ,real-time-ms (getf args :real-time-ms 0) 100 | ,gc-run-time-ms (getf args :gc-run-time-ms 0) 101 | ,gc-real-time-ms (getf args :gc-real-time-ms 0) 102 | ,processor-cycles (getf args :processor-cycles 0) 103 | ,eval-calls (getf args :eval-calls 0) 104 | ,lambdas-converted (getf args :lambdas-converted 0) 105 | ,page-faults (getf args :page-faults 0) 106 | ,bytes-consed (getf args :bytes-consed 0))) 107 | (lambda () ,form))) 108 | (:commit (commit-fn) 109 | `(,commit-fn user-run-time (/ ,user-run-time-us 1000000) 110 | system-run-time (/ ,system-run-time-us 1000000) 111 | real-time (/ ,real-time-ms 1000) 112 | gc-run-time (/ ,gc-run-time-ms 1000) 113 | gc-real-time (/ ,gc-real-time-ms 1000) 114 | processor-cycles ,processor-cycles 115 | eval-calls ,eval-calls 116 | lambdas-converted ,lambdas-converted 117 | page-faults ,page-faults 118 | bytes-consed ,bytes-consed)))) 119 | 120 | #+ecl 121 | (progn 122 | (define-delta-sampler (bytes-consed) 123 | (ffi:c-inline () () :object "ecl_make_unsigned_integer(GC_get_total_bytes())" :one-liner t))) 124 | 125 | 126 | #+sbcl 127 | (setf *default-samplers* '(sb-time)) 128 | #+ecl 129 | (setf *default-samplers* '(real-time run-time bytes-consed)) 130 | #-(or ecl sbcl) 131 | (setf *default-samplers* '(real-time run-time)) 132 | -------------------------------------------------------------------------------- /timer.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.trivial-benchmark) 2 | 3 | (defvar *default-computations* '(:total :minimum :maximum :median :average :deviation)) 4 | (defvar *default-metrics* ()) 5 | 6 | (defgeneric compute (thing samples)) 7 | (defgeneric report-to (stream thing &key)) 8 | (defgeneric samples (timer metric)) 9 | (defgeneric metric-types (timer)) 10 | (defgeneric reset (timer)) 11 | 12 | (defun report (thing &rest args &key (stream T) &allow-other-keys) 13 | (remf args :stream) 14 | (apply #'report-to stream thing args)) 15 | 16 | (defmethod compute ((x (eql :count)) (samples vector)) 17 | (length samples)) 18 | 19 | (defmethod compute ((x (eql :samples)) (samples vector)) 20 | (length samples)) 21 | 22 | (defmethod compute ((x (eql :total)) (samples vector)) 23 | (if (= 0 (length samples)) 24 | :n/a 25 | (reduce #'+ samples))) 26 | 27 | (defmethod compute ((x (eql :minimum)) (samples vector)) 28 | (if (= 0 (length samples)) 29 | :n/a 30 | (reduce #'min samples))) 31 | 32 | (defmethod compute ((x (eql :maximum)) (samples vector)) 33 | (if (= 0 (length samples)) 34 | :n/a 35 | (reduce #'max samples))) 36 | 37 | (defmethod compute ((x (eql :median)) (samples vector)) 38 | (if (= 0 (length samples)) 39 | :n/a 40 | (elt (sort (copy-seq samples) #'<) 41 | (1- (ceiling (/ (length samples) 2)))))) 42 | 43 | (defmethod compute ((x (eql :average)) (samples vector)) 44 | (if (= 0 (length samples)) 45 | :n/a 46 | (/ (reduce #'+ samples) (length samples)))) 47 | 48 | (defmethod compute ((x (eql :deviation)) (samples vector)) 49 | (if (= 0 (length samples)) 50 | :n/a 51 | (let ((average (compute :average samples))) 52 | (sqrt 53 | (/ (reduce #'+ samples :key (lambda (a) (expt (- a average) 2))) 54 | (length samples)))))) 55 | 56 | (defmethod compute ((computations sequence) samples) 57 | (map (type-of computations) (lambda (thing) (compute thing samples)) computations)) 58 | 59 | (defmethod report-to ((stream (eql T)) thing &rest args &key &allow-other-keys) 60 | (apply #'report-to *standard-output* thing args)) 61 | 62 | (defmethod report-to ((string (eql NIL)) thing &rest args &key &allow-other-keys) 63 | (with-output-to-string (stream) 64 | (apply #'report-to stream thing args))) 65 | 66 | (defmethod report-to ((stream stream) (samples vector) &rest args &key computations &allow-other-keys) 67 | (remf args :computations) 68 | (apply #'print-table 69 | (cons (list :computation :value) 70 | (loop for comp in computations 71 | collect (list comp (compute comp samples)))) 72 | :stream stream args)) 73 | 74 | (defclass timer () 75 | ((metrics :initform (make-hash-table :test 'eql) :accessor metrics))) 76 | 77 | (defmethod print-object ((timer timer) stream) 78 | (print-unreadable-object (timer stream :type T) 79 | (format stream "~{~a~^ ~}" (metric-types timer)))) 80 | 81 | (defmethod samples ((timer timer) metric) 82 | (or (gethash metric (metrics timer)) 83 | (setf (gethash metric (metrics timer)) (make-array 1024 :adjustable T :fill-pointer 0)))) 84 | 85 | (defmethod metric-types ((timer timer)) 86 | (loop for key being the hash-keys of (metrics timer) collect key)) 87 | 88 | (defun format-timer-stats (stream timer &rest args 89 | &key (computations *default-computations*) 90 | (metrics *default-metrics*) 91 | &allow-other-keys) 92 | (remf args :computations) 93 | (remf args :metrics) 94 | (apply #'print-table 95 | (cons (cons :- computations) 96 | (loop for metric in (or metrics 97 | (loop for k being the hash-keys of (metrics timer) collect k)) 98 | for samples = (samples timer metric) 99 | when (< 0 (length samples)) 100 | collect (list* metric 101 | (mapcar (lambda (a) 102 | (typecase a 103 | (float (round-to a 6)) 104 | (T a))) 105 | (compute computations samples))))) 106 | :stream stream args)) 107 | 108 | (defmethod describe-object ((timer timer) stream) 109 | (let ((*print-pretty* T)) 110 | (format stream "This is an object for keeping benchmarking data.") 111 | (format stream "~&~%It tracks the following metric types:") 112 | (pprint-indent :block 2 stream) 113 | (format stream "~&~{~a~^, ~}" (metric-types timer)) 114 | (terpri stream) 115 | (format stream "~&~%The statistics for the timer are:~&") 116 | (report timer :stream stream))) 117 | 118 | (defmethod report-to ((stream stream) (timer timer) &rest args &key &allow-other-keys) 119 | (if (loop for samples being the hash-values of (metrics timer) 120 | thereis (< 0 (length samples))) 121 | (apply #'format-timer-stats stream timer args) 122 | (format stream "No metric has any samples yet.")) 123 | timer) 124 | 125 | (defmethod reset ((timer timer)) 126 | (loop for samples being the hash-values of (metrics timer) 127 | do (setf (fill-pointer samples) 0)) 128 | timer) 129 | 130 | (defmacro with-sampling ((timer-form &rest samplers) &body forms) 131 | (let* ((timer (gensym "TIMER")) 132 | (commit-fn (gensym "COMMIT")) 133 | (samplers (loop for sampler in (or samplers *default-samplers*) 134 | collect (make-instance sampler))) 135 | (form `(progn ,@forms)) 136 | (vars (loop for sampler in samplers 137 | append (variables sampler)))) 138 | (loop for sampler in samplers 139 | do (setf form (wrap-measurement-form sampler form))) 140 | `(let ((,timer ,timer-form) 141 | ,@(loop for var in vars 142 | collect `(,(first var) ,(second var)))) 143 | (declare ,@(loop for var in vars 144 | collect `(type ,(third var) ,(first var)))) 145 | (multiple-value-prog1 146 | ,form 147 | (macrolet ((,commit-fn (&rest pairs) 148 | `(progn ,@(loop for (metric sample) on pairs by #'cddr 149 | collect `(vector-push-extend (float ,sample 0f0) (samples ,',timer ',metric)))))) 150 | ,@(loop for sampler in samplers 151 | collect (commit-samples-form sampler commit-fn))))))) 152 | 153 | (defmacro with-timing ((n &rest report-args 154 | &key ((:timer timer-form) '(make-instance 'timer)) 155 | (samplers *default-samplers*)) 156 | &body forms) 157 | (remf report-args :samplers) 158 | (remf report-args :timer) 159 | 160 | (when (symbolp samplers) 161 | (setf samplers 162 | (eval samplers))) 163 | 164 | (let ((timer (gensym "TIMER"))) 165 | `(let ((,timer ,timer-form)) 166 | (loop repeat ,n 167 | do (with-sampling (,timer ,@samplers) 168 | ,@forms)) 169 | (report ,timer ,@report-args)))) 170 | -------------------------------------------------------------------------------- /toolkit.lisp: -------------------------------------------------------------------------------- 1 | (in-package #:org.shirakumo.trivial-benchmark) 2 | 3 | (defun print-table (table &key (stream T) (padding 1) (format :fancy)) 4 | (let* ((columns (length (first table))) 5 | (widths (append (loop for i from 0 below columns 6 | collect (loop for row in table 7 | maximize (+ (* 2 padding) (length (princ-to-string (nth i row)))))) 8 | '(0))) 9 | (values (loop for row in table 10 | collect (loop for value in row 11 | for width in widths 12 | collect width collect value)))) 13 | (ecase format 14 | (:princ 15 | (princ table stream)) 16 | (:minimal 17 | (loop for row = (pop values) 18 | do (loop for (width val) on row by #'cddr 19 | do (format stream "~v{ ~}" padding 0) 20 | (format stream "~vf" (- width padding padding) val) 21 | (format stream "~v{ ~}" padding 0)) 22 | (format stream "~%") 23 | while values)) 24 | (:fancy 25 | (format stream "┌~{~v{─~}~^┬~:*~}┐~%" widths) 26 | (loop for row = (pop values) 27 | do (format stream "│") 28 | (loop for (width val) on row by #'cddr 29 | do (format stream "~v{ ~}" padding 0) 30 | (format stream "~vf" (- width padding padding) val) 31 | (format stream "~v{ ~}│" padding 0)) 32 | (format stream "~%") 33 | (when values 34 | (format stream "├~{~v{─~}~^┼~:*~}┤~%" widths)) 35 | while values) 36 | (format stream "└~{~v{─~}~^┴~:*~}┘" widths))))) 37 | 38 | (defun round-to (num n) 39 | (let ((n (expt 10 n))) 40 | (/ (fround (* num n)) n))) 41 | 42 | (defun enlist (thing &rest args) 43 | (if (listp thing) 44 | thing 45 | (list* thing args))) 46 | 47 | (defun unlist (thing) 48 | (if (listp thing) 49 | (first thing) 50 | thing)) 51 | 52 | (defun add-nickname () 53 | (rename-package #.*package* (package-name #.*package*) '(#:tb #:trivial-benchmark))) 54 | -------------------------------------------------------------------------------- /trivial-benchmark.asd: -------------------------------------------------------------------------------- 1 | (defsystem trivial-benchmark 2 | :name "Trivial-Benchmark" 3 | :version "3.0.0" 4 | :license "zlib" 5 | :author "Yukari Hafner " 6 | :maintainer "Yukari Hafner " 7 | :description "An easy to use benchmarking system." 8 | :homepage "https://shinmera.github.io/trivial-benchmark/" 9 | :bug-tracker "https://github.com/Shinmera/trivial-benchmark/issues" 10 | :source-control (:git "https://github.com/Shinmera/trivial-benchmark.git") 11 | :depends-on (:documentation-utils) 12 | :serial T 13 | :components ((:file "package") 14 | (:file "toolkit") 15 | (:file "sampler") 16 | (:file "timer") 17 | (:file "documentation"))) 18 | --------------------------------------------------------------------------------