1 ;;; context-coloring-benchmark.el --- Benchmarks for context coloring -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; This program is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation, either version 3 of the License, or
10 ;; (at your option) any later version.
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
22 ;; Benchmarks for context coloring.
24 ;; Use with `make bench'.
28 (require 'context-coloring)
32 (defconst context-coloring-benchmark-path
33 (file-name-directory (or load-file-name buffer-file-name))
34 "This file's directory.")
36 (defun context-coloring-benchmark-resolve-path (path)
37 "Resolve PATH from this file's directory."
38 (expand-file-name path context-coloring-benchmark-path))
40 (defun context-coloring-benchmark-next-tick (callback)
41 "Run CALLBACK in the next turn of the event loop."
42 (run-with-timer nil nil callback))
44 (defun context-coloring-benchmark-series (sequence callback)
45 "Call each function in SEQUENCE, then call CALLBACK. Each
46 function is passed a single callback parameter for it to call
55 (context-coloring-benchmark-next-tick
57 (context-coloring-benchmark-series
61 (defun context-coloring-benchmark-mapc (sequence iteratee callback)
62 "For each element in SEQUENCE, call ITERATEE, finally call
63 CALLBACK. ITERATEE is passed the current element and a callback
64 for it to call when it is done."
73 (context-coloring-benchmark-next-tick
75 (context-coloring-benchmark-mapc
80 (defun context-coloring-benchmark-log-results (result-file fixture statistics)
81 "Log benchmarking results to RESULT-FILE for fixture FIXTURE
86 (buffer-substring-no-properties (point-min) (point-max)))
88 (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
91 (goto-char (point-min))
92 (insert (format "For fixture \"%s\":\n" fixture))
94 (insert "General statistics:\n")
95 (insert (format "File size: %s bytes\n" (plist-get statistics :file-size)))
96 (insert (format "Lines: %s\n" (plist-get statistics :lines)))
97 (insert (format "Words: %s\n" (plist-get statistics :words)))
98 (insert (format "Colorization times: %s\n"
99 (context-coloring-join
100 (mapcar (lambda (number)
101 (format "%.4f" number))
102 (plist-get statistics :colorization-times)) ", ")))
103 (insert (format "Average colorization time: %.4f\n"
104 (plist-get statistics :average-colorization-time)))
106 (insert "Function statistics:\n")
107 (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
110 (buffer-substring-no-properties (point-min) (point-max)))
113 (defun context-coloring-benchmark (title setup teardown fixtures callback)
114 "Execute a benchmark titled TITLE with SETUP and TEARDOWN
115 callbacks. Measure the performance of all FIXTURES, calling
116 CALLBACK when all are done."
118 (elp-instrument-package "context-coloring-")
119 (let ((result-file (context-coloring-benchmark-resolve-path
120 (format "./logs/results-%s-%s.log"
121 title (format-time-string "%s")))))
122 (context-coloring-benchmark-mapc
124 (lambda (path callback)
125 (let ((fixture (context-coloring-benchmark-resolve-path path))
126 colorization-start-time
127 (colorization-times '())
132 (lambda (original-function)
136 (setq count (+ count 1))
137 (push (- (float-time) colorization-start-time) colorization-times)
141 (advice-remove #'context-coloring-colorize advice)
142 (context-coloring-benchmark-log-results
146 :file-size (nth 7 (file-attributes fixture))
147 :lines (count-lines (point-min) (point-max))
148 :words (count-words (point-min) (point-max))
149 :colorization-times colorization-times
150 :average-colorization-time (/ (apply #'+ colorization-times) 5)))
154 (setq colorization-start-time (float-time))
155 (context-coloring-colorize))))))))
156 (advice-add #'context-coloring-colorize :around advice)
157 (setq colorization-start-time (float-time))
158 (find-file fixture)))
161 (funcall callback)))))
163 (defconst context-coloring-benchmark-js-fixtures
164 '("./fixtures/jquery-2.1.1.js"
165 "./fixtures/lodash-2.4.1.js"
166 "./fixtures/async-0.9.0.js"
167 "./fixtures/mkdirp-0.5.0.js")
168 "Arbitrary JavaScript files for performance scrutiny.")
170 (defun context-coloring-benchmark-js-mode-run (callback)
171 "Benchmark `js-mode', then call CALLBACK."
172 (context-coloring-benchmark
175 "Preparation logic for `js-mode'."
176 (add-hook 'js-mode-hook #'context-coloring-mode))
178 "Cleanup logic for `js-mode'."
179 (remove-hook 'js-mode-hook #'context-coloring-mode))
180 context-coloring-benchmark-js-fixtures
183 (defun context-coloring-benchmark-js2-mode-run (callback)
184 "Benchmark `js2-mode', then call CALLBACK."
185 (context-coloring-benchmark
188 "Preparation logic for `js2-mode'."
189 (setq js2-mode-show-parse-errors nil)
190 (setq js2-mode-show-strict-warnings nil)
191 (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
192 (add-hook 'js2-mode-hook #'context-coloring-mode))
194 "Cleanup logic for `js2-mode'."
195 (remove-hook 'js2-mode-hook #'context-coloring-mode)
196 (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
198 (setq js2-mode-show-strict-warnings t)
199 (setq js2-mode-show-parse-errors t))
200 context-coloring-benchmark-js-fixtures
203 (defconst context-coloring-benchmark-emacs-lisp-fixtures
204 '("./fixtures/lisp.el"
205 "./fixtures/faces.el"
207 "./fixtures/simple.el")
208 "Arbitrary Emacs Lisp files for performance scrutiny.")
210 (defun context-coloring-benchmark-emacs-lisp-mode-run (callback)
211 "Benchmark `emacs-lisp-mode', then call CALLBACK."
212 (context-coloring-benchmark
215 "Preparation logic for `emacs-lisp-mode'."
216 (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
218 "Cleanup logic for `emacs-lisp-mode'."
219 (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
220 context-coloring-benchmark-emacs-lisp-fixtures
223 (defun context-coloring-benchmark-run ()
224 "Benchmark all modes, then exit."
225 (context-coloring-benchmark-series
227 #'context-coloring-benchmark-js-mode-run
228 #'context-coloring-benchmark-js2-mode-run
229 #'context-coloring-benchmark-emacs-lisp-mode-run)
233 (provide 'context-coloring-benchmark)
235 ;;; context-coloring-benchmark.el ends here