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)
33 (defconst context-coloring-benchmark-path
34 (file-name-directory (or load-file-name buffer-file-name))
35 "This file's directory.")
37 (defun context-coloring-benchmark-resolve-path (path)
38 "Resolve PATH from this file's directory."
39 (expand-file-name path context-coloring-benchmark-path))
41 (defun context-coloring-benchmark-log-results (result-file fixture statistics)
42 "Log results to RESULT-FILE for FIXTURE with STATISTICS."
46 (buffer-substring-no-properties (point-min) (point-max)))
48 (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
51 (goto-char (point-min))
52 (insert (format "For fixture \"%s\":\n" fixture))
54 (insert "General statistics:\n")
55 (insert (format "File size: %s bytes\n" (plist-get statistics :file-size)))
56 (insert (format "Lines: %s\n" (plist-get statistics :lines)))
57 (insert (format "Words: %s\n" (plist-get statistics :words)))
58 (insert (format "Colorization times: %s\n"
59 (context-coloring-join
60 (mapcar (lambda (number)
61 (format "%.4f" number))
62 (plist-get statistics :colorization-times)) ", ")))
63 (insert (format "Average colorization time: %.4f\n"
64 (plist-get statistics :average-colorization-time)))
66 (insert "Function statistics:\n")
67 (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
70 (buffer-substring-no-properties (point-min) (point-max)))
73 (defun context-coloring-benchmark (title fixtures)
74 "Execute a benchmark titled TITLE against FIXTURES."
75 (let ((result-file (context-coloring-benchmark-resolve-path
76 (format "./logs/results-%s-%s.log"
77 title (format-time-string "%s")))))
80 (let ((fixture (context-coloring-benchmark-resolve-path path))
81 colorization-start-time
82 (colorization-times '())
87 (lambda (original-function)
88 (funcall original-function)
89 (setq count (+ count 1))
90 ;; First 5 runs are for gathering real coloring times,
91 ;; unaffected by elp instrumentation.
93 (push (- (float-time) colorization-start-time) colorization-times))
96 (advice-remove #'context-coloring-colorize advice)
97 (context-coloring-benchmark-log-results
101 :file-size (nth 7 (file-attributes fixture))
102 :lines (count-lines (point-min) (point-max))
103 :words (count-words (point-min) (point-max))
104 :colorization-times colorization-times
105 :average-colorization-time (/ (apply #'+ colorization-times) 5)))
108 ;; The last 5 runs are for gathering function call and
109 ;; duration statistics.
111 (elp-instrument-package "context-coloring-")
112 (context-coloring-colorize))
114 (setq colorization-start-time (float-time))
115 (context-coloring-colorize))))))
116 (advice-add #'context-coloring-colorize :around advice)
117 (setq colorization-start-time (float-time))
118 (find-file fixture)))
121 (defconst context-coloring-benchmark-javascript-fixtures
122 '("./fixtures/jquery-2.1.1.js"
123 "./fixtures/lodash-2.4.1.js"
124 "./fixtures/async-0.9.0.js"
125 "./fixtures/mkdirp-0.5.0.js")
126 "Arbitrary JavaScript files for performance scrutiny.")
128 (defun context-coloring-benchmark-js2-mode-run ()
129 "Benchmark `js2-mode'."
130 (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
131 (add-hook 'js2-mode-hook #'context-coloring-mode)
132 (let ((js2-mode-show-parse-errors nil)
133 (js2-mode-show-strict-warnings nil))
134 (context-coloring-benchmark
136 context-coloring-benchmark-javascript-fixtures))
137 (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
139 (remove-hook 'js2-mode-hook #'context-coloring-mode))
141 (defconst context-coloring-benchmark-emacs-lisp-fixtures
142 '("./fixtures/lisp.el"
143 "./fixtures/faces.el"
145 "./fixtures/simple.el")
146 "Arbitrary Emacs Lisp files for performance scrutiny.")
148 (defun context-coloring-benchmark-emacs-lisp-mode-run ()
149 "Benchmark `emacs-lisp-mode', then call CALLBACK."
150 (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode)
151 (context-coloring-benchmark
153 context-coloring-benchmark-emacs-lisp-fixtures)
154 (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
156 (defun context-coloring-benchmark-run ()
157 "Benchmark all modes, then exit."
158 (context-coloring-benchmark-js2-mode-run)
159 (context-coloring-benchmark-emacs-lisp-mode-run)
162 (provide 'context-coloring-benchmark)
164 ;;; context-coloring-benchmark.el ends here