code.delx.au - gnu-emacs-elpa/blob - benchmark/context-coloring-benchmark.el

   1 ;;; context-coloring-benchmark.el --- Benchmarks for context coloring  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; This file is part of GNU Emacs.
   6
   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.
  11
  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.
  16
  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/>.
  19
  20 ;;; Commentary:
  21
  22 ;; Benchmarks for context coloring.
  23
  24 ;; Use with `make bench'.
  25
  26 ;;; Code:
  27
  28 (require 'context-coloring)
  29 (require 'js2-mode)
  30
  31
  32 (defconst context-coloring-benchmark-path
  33   (file-name-directory (or load-file-name buffer-file-name))
  34   "This file's directory.")
  35
  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))
  39
  40 (defun context-coloring-benchmark-next-tick (callback)
  41   (run-with-timer nil nil callback))
  42
  43 (defun context-coloring-benchmark-series (sequence callback)
  44   "Call each function in SEQUENCE, then call CALLBACK.  Each
  45 function is passed a single callback parameter for it to call
  46 when it is done."
  47   (cond
  48    ((null sequence)
  49     (funcall callback))
  50    (t
  51     (funcall
  52      (car sequence)
  53      (lambda ()
  54        (context-coloring-benchmark-next-tick
  55         (lambda ()
  56           (context-coloring-benchmark-series
  57            (cdr sequence)
  58            callback))))))))
  59
  60 (defun context-coloring-benchmark-mapc (sequence iteratee callback)
  61   "For each element in SEQUENCE, call ITERATEE, finally call
  62 CALLBACK.  ITERATEE is passed the current element and a callback
  63 for it to call when it is done."
  64   (cond
  65    ((null sequence)
  66     (funcall callback))
  67    (t
  68     (funcall
  69      iteratee
  70      (car sequence)
  71      (lambda ()
  72        (context-coloring-benchmark-next-tick
  73         (lambda ()
  74           (context-coloring-benchmark-mapc
  75            (cdr sequence)
  76            iteratee
  77            callback))))))))
  78
  79 (defun context-coloring-benchmark-log-results (result-file fixture statistics)
  80   "Log benchmarking results to RESULT-FILE for fixture FIXTURE
  81 with STATISTICS."
  82   (let ((results (prog1
  83                      (progn
  84                        (elp-results)
  85                        (buffer-substring-no-properties (point-min) (point-max)))
  86                    (kill-buffer))))
  87     (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
  88     (append-to-file
  89      (with-temp-buffer
  90        (goto-char (point-min))
  91        (insert (format "For fixture \"%s\":\n" fixture))
  92        (insert "\n")
  93        (insert "General statistics:\n")
  94        (insert (format "File size: %s bytes\n" (plist-get statistics :file-size)))
  95        (insert (format "Lines: %s\n" (plist-get statistics :lines)))
  96        (insert (format "Words: %s\n" (plist-get statistics :words)))
  97        (insert (format "Colorization times: %s\n"
  98                        (context-coloring-join
  99                         (mapcar (lambda (number)
 100                                   (format "%.4f" number))
 101                                 (plist-get statistics :colorization-times)) ", ")))
 102        (insert (format "Average colorization time: %.4f\n"
 103                        (plist-get statistics :average-colorization-time)))
 104        (insert "\n")
 105        (insert "Function statistics:\n")
 106        (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
 107        (insert results)
 108        (insert "\n")
 109        (buffer-substring-no-properties (point-min) (point-max)))
 110      nil result-file)))
 111
 112 (defun context-coloring-benchmark (title setup teardown fixtures callback)
 113   "Execute a benchmark titled TITLE with SETUP and TEARDOWN
 114 callbacks.  Measure the performance of all FIXTURES, calling
 115 CALLBACK when all are done."
 116   (funcall setup)
 117   (elp-instrument-package "context-coloring-")
 118   (let ((result-file (context-coloring-benchmark-resolve-path
 119                       (format "./logs/results-%s-%s.log"
 120                               title (format-time-string "%s")))))
 121     (context-coloring-benchmark-mapc
 122      fixtures
 123      (lambda (path callback)
 124        (let ((fixture (context-coloring-benchmark-resolve-path path))
 125              colorization-start-time
 126              (colorization-times '())
 127              advice)
 128          (setq
 129           advice
 130           (let ((count 0))
 131             (lambda (original-function)
 132               (funcall
 133                original-function
 134                (lambda ()
 135                  (setq count (+ count 1))
 136                  (push (- (float-time) colorization-start-time) colorization-times)
 137                  ;; Test 5 times.
 138                  (cond
 139                   ((= count 5)
 140                    (advice-remove #'context-coloring-colorize advice)
 141                    (context-coloring-benchmark-log-results
 142                     result-file
 143                     fixture
 144                     (list
 145                      :file-size (nth 7 (file-attributes fixture))
 146                      :lines (count-lines (point-min) (point-max))
 147                      :words (count-words (point-min) (point-max))
 148                      :colorization-times colorization-times
 149                      :average-colorization-time (/ (apply #'+ colorization-times) 5)))
 150                    (kill-buffer)
 151                    (funcall callback))
 152                   (t
 153                    (setq colorization-start-time (float-time))
 154                    (context-coloring-colorize))))))))
 155          (advice-add #'context-coloring-colorize :around advice)
 156          (setq colorization-start-time (float-time))
 157          (find-file fixture)))
 158      (lambda ()
 159        (funcall teardown)
 160        (funcall callback)))))
 161
 162 (defconst context-coloring-benchmark-js-fixtures
 163   '("./fixtures/jquery-2.1.1.js"
 164     "./fixtures/lodash-2.4.1.js"
 165     "./fixtures/async-0.9.0.js"
 166     "./fixtures/mkdirp-0.5.0.js")
 167   "Arbitrary JavaScript files for performance scrutiny.")
 168
 169 (defun context-coloring-benchmark-js-mode-run (callback)
 170   "Benchmark `js-mode', then call CALLBACK."
 171   (context-coloring-benchmark
 172    "js-mode"
 173    (lambda ()
 174      "Preparation logic for `js-mode'."
 175      (add-hook 'js-mode-hook #'context-coloring-mode))
 176    (lambda ()
 177      "Cleanup logic for `js-mode'."
 178      (remove-hook 'js-mode-hook #'context-coloring-mode))
 179    context-coloring-benchmark-js-fixtures
 180    callback))
 181
 182 (defun context-coloring-benchmark-js2-mode-run (callback)
 183   "Benchmark `js2-mode', then call CALLBACK."
 184   (context-coloring-benchmark
 185    "js2-mode"
 186    (lambda ()
 187      "Preparation logic for `js2-mode'."
 188      (setq js2-mode-show-parse-errors nil)
 189      (setq js2-mode-show-strict-warnings nil)
 190      (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
 191      (add-hook 'js2-mode-hook #'context-coloring-mode))
 192    (lambda ()
 193      "Cleanup logic for `js2-mode'."
 194      (remove-hook 'js2-mode-hook #'context-coloring-mode)
 195      (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
 196                                    auto-mode-alist))
 197      (setq js2-mode-show-strict-warnings t)
 198      (setq js2-mode-show-parse-errors t))
 199    context-coloring-benchmark-js-fixtures
 200    callback))
 201
 202 (defconst context-coloring-benchmark-emacs-lisp-fixtures
 203   '("./fixtures/lisp.el"
 204     "./fixtures/faces.el"
 205     "./fixtures/subr.el"
 206     "./fixtures/simple.el")
 207   "Arbitrary Emacs Lisp files for performance scrutiny.")
 208
 209 (defun context-coloring-benchmark-emacs-lisp-mode-run (callback)
 210   "Benchmark `emacs-lisp-mode', then call CALLBACK."
 211   (context-coloring-benchmark
 212    "emacs-lisp-mode"
 213    (lambda ()
 214      "Preparation logic for `emacs-lisp-mode'."
 215      (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
 216    (lambda ()
 217      "Cleanup logic for `emacs-lisp-mode'."
 218      (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
 219    context-coloring-benchmark-emacs-lisp-fixtures
 220    callback))
 221
 222 (defun context-coloring-benchmark-run ()
 223   "Benchmark all modes, then exit."
 224   (context-coloring-benchmark-series
 225    (list
 226     #'context-coloring-benchmark-js-mode-run
 227     #'context-coloring-benchmark-js2-mode-run
 228     #'context-coloring-benchmark-emacs-lisp-mode-run)
 229    (lambda ()
 230      (kill-emacs))))
 231
 232 (provide 'context-coloring-benchmark)
 233
 234 ;;; context-coloring-benchmark.el ends here