├── COPYING ├── README.org ├── benchmarks ├── functions.lisp ├── memory-management.lisp ├── numerics.lisp └── report.lisp ├── core ├── benchmarking.lisp ├── monitoring.lisp ├── packages.lisp ├── time-series.lisp ├── timestamps.lisp └── utilities.lisp └── the-cost-of-nothing.asd /COPYING: -------------------------------------------------------------------------------- 1 | Copyright 2016-2018 Marco Heisig 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+BEGIN_QUOTE 2 | A LISP programmer knows the value of everything, but the cost of nothing. 3 | 4 | --- Alan Perlis 5 | #+END_QUOTE 6 | 7 | This library is a toolbox for measuring the run time of Common Lisp code. 8 | It provides macros and functions for accurate benchmarking and lightweight 9 | monitoring. Furthermore, it provides predefined benchmarks to determine 10 | the cost of certain actions on a given platform and implementation. 11 | 12 | I hope you find it useful. If you have new ideas for benchmarks, or 13 | suggestions on how to improve existing ones, feel free to contact me. 14 | 15 | ** Benchmarking 16 | To run all predefined benchmarks, simply execute 17 | 18 | #+BEGIN_SRC lisp :results output 19 | (asdf:test-system :the-cost-of-nothing) 20 | #+END_SRC 21 | 22 | To obtain the execution time of an expression as a double-float in seconds, 23 | execute 24 | #+BEGIN_SRC lisp 25 | (benchmark EXPRESSION) 26 | #+END_SRC 27 | 28 | To have said execution time immediately and human-readably written to 29 | *trace-output* (much like CL:TIME), execute 30 | #+BEGIN_SRC lisp 31 | (bench EXPRESSION) 32 | #+END_SRC 33 | 34 | ** Monitoring 35 | 36 | Coming soon. 37 | 38 | ** Remember 39 | 40 | #+BEGIN_QUOTE 41 | There are lies, damned lies, and benchmarks. 42 | #+END_QUOTE 43 | -------------------------------------------------------------------------------- /benchmarks/functions.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (define-memo-function funcall-cost 4 | (&key (mandatory-arguments 0) 5 | (optional-arguments 0) 6 | (keyword-arguments 0) 7 | (rest-arguments 0)) 8 | (let ((lambda-list (make-lambda-list :mandatory-arguments mandatory-arguments 9 | :optional-arguments optional-arguments 10 | :keyword-arguments keyword-arguments 11 | :rest-arguments rest-arguments)) 12 | (argument-list (make-argument-list :mandatory-arguments mandatory-arguments 13 | :optional-arguments optional-arguments 14 | :keyword-arguments keyword-arguments 15 | :rest-arguments rest-arguments))) 16 | (let ((caller (compiled-lambda 17 | `(callee) 18 | `(funcall callee ,@argument-list))) 19 | (callee (compiled-lambda 20 | lambda-list 21 | `(declare (ignore ,@(lambda-list-bindings lambda-list)))))) 22 | (benchmark 23 | (funcall caller callee))))) 24 | 25 | (defun print-functions-report (&optional (stream *standard-output*)) 26 | (format stream "~&~%== Functions ==~%") 27 | (loop for n below 7 do 28 | (format stream "FUNCALL with ~R mandatory argument~:p: " n) 29 | (finish-output stream) 30 | (print-time (funcall-cost :mandatory-arguments n) stream) 31 | (terpri stream) 32 | (finish-output stream)) 33 | (loop for n below 7 do 34 | (format stream "FUNCALL with ~R optional argument~:p: " n) 35 | (finish-output stream) 36 | (print-time (funcall-cost :optional-arguments n) stream) 37 | (terpri stream) 38 | (finish-output stream)) 39 | (loop for n below 7 do 40 | (format stream "FUNCALL with ~R keyword argument~:p: " n) 41 | (finish-output stream) 42 | (print-time (funcall-cost :keyword-arguments n) stream) 43 | (terpri stream) 44 | (finish-output stream)) 45 | (loop for n below 7 do 46 | (format stream "FUNCALL with ~R rest argument~:p: " n) 47 | (finish-output stream) 48 | (print-time (funcall-cost :rest-arguments n) stream) 49 | (terpri stream) 50 | (finish-output stream))) 51 | -------------------------------------------------------------------------------- /benchmarks/memory-management.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (define-memo-function cons-cost () 4 | (benchmark 5 | (cons nil nil))) 6 | 7 | (define-memo-function make-list-cost (size &key (initial-element nil)) 8 | (benchmark 9 | (make-list size :initial-element initial-element))) 10 | 11 | (define-memo-function make-sequence-cost (result-type length &key (initial-element nil)) 12 | (let ((fast-make-sequence 13 | (compiled-lambda 14 | `(length initial-element) 15 | `(make-sequence ',result-type length :initial-element initial-element)))) 16 | (benchmark 17 | (funcall fast-make-sequence length initial-element)))) 18 | 19 | (define-memo-function make-struct-cost (&key (number-of-slots 0)) 20 | ;; TODO 21 | (values)) 22 | 23 | (define-memo-function make-instance-cost (&key (number-of-slots 0)) 24 | ;; TODO 25 | (values) 26 | ) 27 | 28 | (define-memo-function gc-cost (&key full) 29 | (benchmark 30 | (trivial-garbage:gc :full full))) 31 | 32 | (defun print-memory-management-report (&optional (stream *standard-output*)) 33 | (format stream "~&~%== Memory Management ==~%") 34 | (format stream "Cost of allocating a cons cell: ") (finish-output stream) 35 | (print-time (cons-cost) stream) (terpri stream) (finish-output stream) 36 | (format stream "Cost of garbage collection: ") (finish-output stream) 37 | (print-time (gc-cost) stream) (terpri stream) (finish-output stream) 38 | (format stream "Cost of full garbage collection: ") (finish-output stream) 39 | (print-time (gc-cost :full t) stream) (terpri stream) (finish-output stream)) 40 | -------------------------------------------------------------------------------- /benchmarks/numerics.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (define-memo-function flops (&key (element-type 'single-float)) 4 | (let* ((length 100) 5 | (initial-element (coerce 0 element-type)) 6 | (a1 (make-array 7 | length 8 | :element-type element-type 9 | :initial-element initial-element)) 10 | (a2 (make-array 11 | length 12 | :element-type element-type 13 | :initial-element initial-element)) 14 | (crunch 15 | (compiled-lambda 16 | `(length dst src-1 src-2) 17 | `(declare (type (simple-array ,element-type (*)) dst src-1 src-2)) 18 | `(declare (optimize (speed 3) (safety 0) (debug 0))) 19 | `(loop for index fixnum below length do 20 | (setf (aref dst index) 21 | (+ (* (aref src-1 index) 1/2) 22 | (* (aref src-2 index) 1/4))))))) 23 | (/ (* 3 length) 24 | (benchmark (funcall crunch length a1 a2 a2))))) 25 | 26 | (defun print-numerics-report (&optional (stream *standard-output*)) 27 | (format stream "~&~%== Numerics ==~%") 28 | (format stream "Flops (single-float): ") (finish-output stream) 29 | (write-si-unit (flops :element-type 'single-float) "flops" stream) 30 | (terpri stream) 31 | (finish-output stream) 32 | (format stream "Flops (double-float): ") (finish-output stream) 33 | (write-si-unit (flops :element-type 'double-float) "flops" stream) 34 | (terpri stream) 35 | (finish-output stream)) 36 | -------------------------------------------------------------------------------- /benchmarks/report.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (defun print-report (&optional (stream *standard-output*)) 4 | (format stream "~&~%= The Cost Of Nothing =~%") 5 | (format stream "Implementation: ~:[unknown~;~:*~a~]~@[ ~a~]~%" 6 | (lisp-implementation-type) 7 | (lisp-implementation-version)) 8 | (format stream "Machine: ~:[unknown~;~:*~a~]~@[ ~a~]~%" 9 | (machine-type) 10 | (machine-version)) 11 | (format stream "Hostname: ~a~%" (machine-instance)) 12 | (print-memory-management-report stream) 13 | (print-functions-report stream) 14 | (print-numerics-report stream) 15 | (values)) 16 | 17 | (defun y-intersection-and-slope (x0 y0 x1 y1) 18 | (let* ((dx (- x1 x0)) 19 | (dy (- y1 y0)) 20 | (slope 21 | (if (and (plusp dx) (plusp dy)) 22 | (/ dy dx) 23 | 0d0)) 24 | (y-intersection 25 | (max 0d0 (- y0 (* slope x0))))) 26 | (values y-intersection slope))) 27 | -------------------------------------------------------------------------------- /core/benchmarking.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (declaim (notinline touch)) 4 | (defun touch (object) 5 | "Protect OBJECT from compiler optimization." 6 | object) 7 | 8 | (defmacro bench (form &rest args &key max-samples min-sample-time timeout overhead) 9 | "Evaluate FORM multiple times and print the averaged execution time to 10 | *TRACE-OUTPUT*. 11 | 12 | Examples: 13 | (bench nil) => 0.00 nanoseconds 14 | (bench (make-hash-table)) => 247.03 nanoseconds" 15 | (declare (ignore max-samples min-sample-time timeout overhead)) 16 | `(progn (print-time (benchmark ,form ,@args) *trace-output*) 17 | (values))) 18 | 19 | (defmacro benchmark (form &rest args &key max-samples min-sample-time timeout overhead) 20 | "Execute BODY multiple times to accurately measure its execution time in 21 | seconds. The returned values are literally the same as those from an 22 | invocation of MEASURE-EXECUTION-TIME with suitable lambdas. 23 | 24 | Examples: 25 | (benchmark (cons nil nil)) -> 3.3d-9 1.0 36995264 26 | (benchmark (gc :full t)) -> 0.031 0.9 90" 27 | (declare (ignore max-samples min-sample-time timeout overhead)) 28 | `(benchmark-thunk (lambda () ,form) ,@args)) 29 | 30 | (defvar *default-overhead*) 31 | 32 | (defvar *default-min-sample-time* 0.05) 33 | 34 | (defun benchmark-thunk (thunk &key (timeout 2.0) 35 | (min-sample-time *default-min-sample-time*) 36 | (max-samples (/ timeout min-sample-time)) 37 | (overhead *default-overhead*)) 38 | (let ((tmax (local-time:timestamp+ 39 | (local-time:now) 40 | (floor (* timeout 1.0e9)) :nsec)) 41 | (samples '()) 42 | (number-of-samples 0)) 43 | (loop do (push (sample-execution-time-of-thunk thunk min-sample-time) samples) 44 | (incf number-of-samples) 45 | until (or (local-time:timestamp>= (local-time:now) tmax) 46 | (and (not (null max-samples)) 47 | (>= number-of-samples max-samples)))) 48 | (- (/ (reduce #'+ samples) 49 | (coerce number-of-samples 'single-float)) 50 | overhead))) 51 | 52 | (defun sample-execution-time-of-thunk (thunk min-sample-time) 53 | "Measure the execution time of invoking THUNK more and more often, until 54 | the execution time exceeds MIN-SAMPLE-TIME." 55 | (loop for iterations = 1 then (1+ (* iterations (1+ (random 4)))) 56 | for execution-time = (max 0.0d0 (execution-time-of-thunk 57 | (lambda () 58 | (loop repeat iterations do 59 | (funcall thunk))))) 60 | when (> execution-time min-sample-time) 61 | do (return (/ execution-time iterations)))) 62 | 63 | (defun execution-time-of-thunk (thunk) 64 | "Execute THUNK and return the execution time of THUNK in seconds as a 65 | double-float." 66 | (let* ((t0 (local-time:now)) 67 | (_ (funcall thunk)) 68 | (t1 (local-time:now))) 69 | (declare (ignore _)) 70 | (max 0.0d0 (local-time:timestamp-difference t1 t0)))) 71 | 72 | (defvar *default-overhead* (benchmark nil :timeout 2.0 :overhead 0.0)) 73 | -------------------------------------------------------------------------------- /core/monitoring.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (defvar *context* '() 4 | "A list of the names of all surrounding monitoring regions.") 5 | 6 | (defvar *measurements* nil 7 | "An object suitable as a second argument to STORE-MEASUREMENT.") 8 | 9 | (defstruct (measurement 10 | (:predicate measurementp) 11 | (:constructor make-measurement (value name))) 12 | (value nil) 13 | (name nil) 14 | (context *context*) 15 | (timestamp (make-timestamp))) 16 | 17 | (defmacro monitor (form &key (name `',form)) 18 | "Monitor VALUE by storing a measurement in *MEASUREMENTS*. If 19 | *MEASUREMENTS* is NIL, no measurement is recorded. 20 | 21 | The keyword argument NAME can be used to describe the nature of the 22 | measurement. The default name of an measurement is the VALUE form that is 23 | the first argument of this macro." 24 | (let((value (gensym))) 25 | `(let ((,value ,form)) 26 | (%monitor ,value ,name) 27 | ,value))) 28 | 29 | (defun %monitor (value name) 30 | (let ((storage *measurements*)) 31 | (unless (null storage) 32 | (let ((measurement (make-measurement value name))) 33 | (store-measurement measurement storage)))) 34 | (values)) 35 | 36 | (defgeneric store-measurement (measurement storage) 37 | (:method (measurement (null null)) 38 | (declare (ignore measurement)) 39 | (values))) 40 | 41 | (defmethod print-object ((measurement measurement) stream) 42 | (if *print-pretty* 43 | (format stream "~@<#<~;~S ~_~@{~S ~S~^ ~_~}~;>~:>" 44 | (class-name (class-of measurement)) 45 | :value (measurement-value measurement) 46 | :name (measurement-name measurement) 47 | :timestamp (measurement-timestamp measurement)) 48 | (print-unreadable-object (measurement stream :type t) 49 | (format stream "~@{~S ~S~^ ~}" 50 | :value (measurement-value measurement) 51 | :name (measurement-name measurement) 52 | :timestamp (measurement-timestamp measurement))))) 53 | 54 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 55 | ;;; 56 | ;;; Monitoring Regions 57 | 58 | (defstruct (monitoring-region-start 59 | (:include measurement) 60 | (:constructor make-monitoring-region-start (name))) 61 | "A measurement that is only emitted when entering a monitoring 62 | region. Its value is the corresponding monitoring region end, or NIL, when 63 | the region is still active.") 64 | 65 | (defstruct (monitoring-region-end 66 | (:include measurement) 67 | (:constructor make-monitoring-region-end (name value))) 68 | "A measurement that is only emitted when leaving a monitoring region. 69 | Its value is the corresponding monitoring region start.") 70 | 71 | (defmacro with-monitoring-region ((name) &body body) 72 | "Execute BODY in a region monitoring NAME. This entails the following things: 73 | 74 | 1. The special variable *MEASUREMENTS* is bound to itself, to ensure that 75 | it has the same value throughout the entire monitoring block. 76 | 77 | 1. An MONITORING-REGION-START measurement is stored right before executing BODY. 78 | Its value is NIL initially, but later set to the corresponding 79 | MONITORING-REGION-END measurement. 80 | 81 | 2. For the dynamic extent of BODY, NAME is prepended to the context of all 82 | measurements. 83 | 84 | 3. A MONITORING-REGION-END measurement is stored once control is transferred 85 | outside of BODY. Its value is the corresponding MONITORING-REGION-START 86 | measurement." 87 | `(call-with-monitoring-region ',name (lambda () ,@body))) 88 | 89 | (defun call-with-monitoring-region (name thunk) 90 | (let* ((*measurements* *measurements*) 91 | (start (make-monitoring-region-start name))) 92 | (store-measurement start *measurements*) 93 | (unwind-protect 94 | (let ((*context* (cons name *context*))) 95 | (funcall thunk)) 96 | (let ((end (make-monitoring-region-end name start))) 97 | (setf (measurement-value start) end) 98 | (store-measurement end *measurements*))))) 99 | 100 | (defmethod print-object ((monitoring-region-start monitoring-region-start) stream) 101 | (print-unreadable-object (monitoring-region-start stream :type t) 102 | (format stream "~@{~S ~S~^ ~}" 103 | :name (measurement-name monitoring-region-start) 104 | :timestamp (measurement-timestamp monitoring-region-start)))) 105 | 106 | (defmethod print-object ((monitoring-region-end monitoring-region-end) stream) 107 | (print-unreadable-object (monitoring-region-end stream :type t) 108 | (format stream "~@{~S ~S~^ ~}" 109 | :name (measurement-name monitoring-region-end) 110 | :timestamp (measurement-timestamp monitoring-region-end)))) 111 | -------------------------------------------------------------------------------- /core/packages.lisp: -------------------------------------------------------------------------------- 1 | (cl:in-package #:common-lisp-user) 2 | 3 | (defpackage #:the-cost-of-nothing 4 | (:use #:closer-common-lisp) 5 | (:export 6 | 7 | ;; Utilities 8 | #:write-si-unit 9 | #:print-time 10 | 11 | ;; Benchmarking 12 | #:touch 13 | #:bench 14 | #:benchmark 15 | #:benchmark-thunk 16 | 17 | ;; Monitoring 18 | #:measurement 19 | #:measurement-value 20 | #:measurement-name 21 | #:measurement-context 22 | #:measurement-timestamp 23 | #:make-measurement 24 | #:measurementp 25 | #:monitor 26 | #:with-monitoring-region 27 | #:monitoring-region-start 28 | #:monitoring-region-end 29 | 30 | ;; Predefined Benchmarks 31 | #:print-report 32 | #:funcall-cost 33 | #:cons-cost 34 | #:gc-cost 35 | #:make-list-cost 36 | #:make-sequence-cost 37 | #:flops)) 38 | -------------------------------------------------------------------------------- /core/time-series.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (defclass time-series () 4 | ((%measurements :initform '() :accessor measurements))) 5 | 6 | -------------------------------------------------------------------------------- /core/timestamps.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (declaim (function *timestamp-function*)) 4 | (defvar *timestamp-function* #'local-time:now) 5 | 6 | (declaim (inline make-timestamp)) 7 | (defun make-timestamp () 8 | (funcall *timestamp-function*)) 9 | 10 | (defmacro with-fuzzy-timestamps ((&key (fuzziness '8)) &body body) 11 | "Set the timestamp fuzziness for the dynamic extent of BODY. This can be 12 | useful for profiling performance critical regions of code, where the cost 13 | of measuring the time would otherwise dominate the execution. 14 | 15 | A timestamp fuzziness of zero means that each call to MAKE-TIMESTAMP 16 | produces a new timestamp. Values bigger than zero mean that MAKE-TIMESTAMP 17 | returns the same timestamp for the given number of consecutive calls." 18 | `(call-with-fuzzy-timestamps 19 | (lambda () ,@body) 20 | (the (integer 0 *) ,fuzziness))) 21 | 22 | (defun call-with-fuzzy-timestamps (thunk fuzziness) 23 | (declare (type (integer 0 *) fuzziness)) 24 | (let ((cache nil) 25 | (counter fuzziness)) 26 | (let ((*timestamp-function* 27 | (lambda () 28 | (cond ((>= counter fuzziness) 29 | (setf counter 0) 30 | (setf cache (local-time:now))) 31 | (t 32 | (incf counter) 33 | cache))))) 34 | (funcall thunk)))) 35 | -------------------------------------------------------------------------------- /core/utilities.lisp: -------------------------------------------------------------------------------- 1 | (in-package :the-cost-of-nothing) 2 | 3 | (defun compiled-lambda (lambda-list &rest body) 4 | (compile nil `(lambda ,lambda-list ,@body))) 5 | 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;; 8 | ;;; Printing 9 | 10 | (defvar *si-prefix-alist* 11 | '(("yotta" . 1d+24) 12 | ("zetta" . 1d+21) 13 | ("exa" . 1d+18) 14 | ("peta" . 1d+15) 15 | ("tera" . 1d+12) 16 | ("giga" . 1d+09) 17 | ("mega" . 1d+06) 18 | ("kilo" . 1d+03) 19 | ("" . 1d+00) 20 | ("milli" . 1d-03) 21 | ("micro" . 1d-06) 22 | ("nano" . 1d-09) 23 | ("pico" . 1d-12) 24 | ("femto" . 1d-15) 25 | ("atto" . 1d-18) 26 | ("zepto" . 1d-21) 27 | ("yocto" . 1d-24))) 28 | 29 | (defun write-si-unit (quantity unit stream) 30 | (check-type quantity float) 31 | (check-type unit string) 32 | (destructuring-bind (prefix . factor) 33 | (or (rassoc-if 34 | (lambda (x) 35 | (declare (double-float x)) 36 | (> (/ quantity x) 1d0)) 37 | *si-prefix-alist*) 38 | '("" . 1d0)) 39 | (format stream "~,2F ~A~A" (/ quantity factor) prefix unit))) 40 | 41 | (defun print-time (time &optional (stream *standard-output*)) 42 | (write-si-unit time "seconds" stream) 43 | time) 44 | 45 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 46 | ;;; 47 | ;;; Memoization 48 | 49 | (defun call-with-memoization (key table thunk) 50 | (multiple-value-bind (values present-p) 51 | (gethash key table) 52 | (values-list 53 | (if (not present-p) 54 | (setf (gethash key table) 55 | (multiple-value-list 56 | (funcall thunk))) 57 | values)))) 58 | 59 | (defmacro with-memoization (key-form &body body) 60 | `(call-with-memoization 61 | ,key-form 62 | (load-time-value (make-hash-table :test 'equal)) 63 | (lambda () ,@body))) 64 | 65 | (defmacro define-memo-function (name lambda-list &body body) 66 | `(defun ,name ,lambda-list 67 | (with-memoization (list ,@(lambda-list-bindings lambda-list)) 68 | ,@body))) 69 | 70 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 71 | ;;; 72 | ;;; Lambda Lists 73 | 74 | (defun nth-keyword-name (n) 75 | (intern (format nil "KEYWORD-~D" n) :the-cost-of-nothing)) 76 | 77 | (defun make-lambda-list (&key (mandatory-arguments 0) 78 | (optional-arguments 0) 79 | (keyword-arguments 0) 80 | (rest-arguments 0)) 81 | `(,@(loop repeat mandatory-arguments 82 | collect (gensym)) 83 | ,@(if (zerop optional-arguments) 84 | `() 85 | `(&optional 86 | ,@(loop repeat optional-arguments 87 | collect `(,(gensym) nil ,(gensym))))) 88 | ,@(if (zerop keyword-arguments) 89 | `() 90 | `(&key 91 | ,@(loop for index below keyword-arguments 92 | for keyword-name = (nth-keyword-name index) 93 | collect `((,keyword-name ,(gensym)) nil ,(gensym))))) 94 | ,@(if (zerop rest-arguments) 95 | `() 96 | `(&rest ,(gensym))))) 97 | 98 | (defun make-argument-list (&key (mandatory-arguments 0) 99 | (optional-arguments 0) 100 | (keyword-arguments 0) 101 | (rest-arguments 0)) 102 | `(,@(make-list mandatory-arguments) 103 | ,@(make-list optional-arguments) 104 | ,@(loop for index below keyword-arguments 105 | for keyword-name = (nth-keyword-name index) 106 | append `(',keyword-name nil)) 107 | ,@(make-list rest-arguments))) 108 | 109 | (defun lambda-list-bindings (lambda-list) 110 | (multiple-value-bind (required optional rest keyword) 111 | (alexandria:parse-ordinary-lambda-list lambda-list) 112 | (append required 113 | (mapcar #'first optional) 114 | (mapcar #'third optional) 115 | (mapcar #'cadar keyword) 116 | (mapcar #'third keyword) 117 | (if (not rest) '() (list rest))))) 118 | 119 | -------------------------------------------------------------------------------- /the-cost-of-nothing.asd: -------------------------------------------------------------------------------- 1 | (defsystem "the-cost-of-nothing" 2 | :description "Determine the cost of things in Common Lisp." 3 | :long-description 4 | "This library provides portable and sophisticated benchmark functions. It 5 | comes bundled with an extensive test suite that describes the performance 6 | of the currently used Lisp implementation, e.g. with respect to garbage 7 | collection, sequence traversal, CLOS and floating-point performance." 8 | :author "Marco Heisig " 9 | :license "MIT" 10 | 11 | :depends-on 12 | ("alexandria" 13 | "closer-mop" 14 | "local-time" 15 | "trivial-garbage") 16 | 17 | :perform 18 | (test-op (o c) (symbol-call '#:the-cost-of-nothing '#:print-report)) 19 | :components 20 | 21 | ((:module "core" 22 | :serial t 23 | :components 24 | ((:file "packages") 25 | (:file "utilities") 26 | (:file "timestamps") 27 | (:file "monitoring") 28 | (:file "benchmarking") 29 | (:file "time-series"))) 30 | 31 | (:module "benchmarks" 32 | :serial t 33 | :components 34 | ((:file "memory-management") 35 | (:file "functions") 36 | (:file "numerics") 37 | (:file "report"))))) 38 | --------------------------------------------------------------------------------