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