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

   1 ;;; context-coloring-benchmark.el --- Benchmarks for context coloring  -*- lexical-binding: t; no-byte-compile: t; -*-
   2
   3 ;; Copyright (C) 2014-2016  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 'context-coloring-javascript)
  30 (require 'context-coloring-emacs-lisp)
  31 (require 'elp)
  32
  33
  34 (defconst context-coloring-benchmark-path
  35   (file-name-directory (or load-file-name buffer-file-name))
  36   "This file's directory.")
  37
  38 (defun context-coloring-benchmark-resolve-path (path)
  39   "Resolve PATH from this file's directory."
  40   (expand-file-name path context-coloring-benchmark-path))
  41
  42 (defun context-coloring-benchmark-log-results (result-file fixture statistics)
  43   "Log results to RESULT-FILE for FIXTURE with STATISTICS."
  44   (let ((results (prog1
  45                      (progn
  46                        (elp-results)
  47                        (buffer-substring-no-properties (point-min) (point-max)))
  48                    (kill-buffer))))
  49     (make-directory (context-coloring-benchmark-resolve-path "./benchmark") t)
  50     (append-to-file
  51      (with-temp-buffer
  52        (goto-char (point-min))
  53        (insert (format "For fixture \"%s\":\n" fixture))
  54        (insert "\n")
  55        (insert "General statistics:\n")
  56        (insert (format "File size: %s bytes\n" (plist-get statistics :file-size)))
  57        (insert (format "Lines: %s\n" (plist-get statistics :lines)))
  58        (insert (format "Words: %s\n" (plist-get statistics :words)))
  59        (insert (format "Colorization times: %s\n"
  60                        (context-coloring-join
  61                         (mapcar (lambda (number)
  62                                   (format "%.4f" number))
  63                                 (plist-get statistics :colorization-times)) ", ")))
  64        (insert (format "Average colorization time: %.4f\n"
  65                        (plist-get statistics :average-colorization-time)))
  66        (insert "\n")
  67        (insert "Function statistics:\n")
  68        (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
  69        (insert results)
  70        (insert "\n")
  71        (buffer-substring-no-properties (point-min) (point-max)))
  72      nil result-file)))
  73
  74 (defun context-coloring-benchmark (title fixtures)
  75   "Execute a benchmark titled TITLE against FIXTURES."
  76   (let ((result-file (context-coloring-benchmark-resolve-path
  77                       (format "./benchmark/results-%s-%s.log"
  78                               title (format-time-string "%s")))))
  79     (mapc
  80      (lambda (path)
  81        (let ((fixture (context-coloring-benchmark-resolve-path path))
  82              colorization-start-time
  83              (colorization-times '())
  84              advice)
  85          (setq
  86           advice
  87           (let ((count 0))
  88             (lambda (original-function)
  89               (funcall original-function)
  90               (setq count (+ count 1))
  91               ;; First 5 runs are for gathering real coloring times,
  92               ;; unaffected by elp instrumentation.
  93               (when (<= count 5)
  94                 (push (- (float-time) colorization-start-time) colorization-times))
  95               (cond
  96                ((= count 10)
  97                 (advice-remove #'context-coloring-colorize advice)
  98                 (context-coloring-benchmark-log-results
  99                  result-file
 100                  fixture
 101                  (list
 102                   :file-size (nth 7 (file-attributes fixture))
 103                   :lines (count-lines (point-min) (point-max))
 104                   :words (count-words (point-min) (point-max))
 105                   :colorization-times colorization-times
 106                   :average-colorization-time (/ (apply #'+ colorization-times) 5)))
 107                 (elp-restore-all)
 108                 (kill-buffer))
 109                ;; The last 5 runs are for gathering function call and
 110                ;; duration statistics.
 111                ((= count 5)
 112                 (elp-instrument-package "context-coloring-")
 113                 (context-coloring-colorize))
 114                (t
 115                 (setq colorization-start-time (float-time))
 116                 (context-coloring-colorize))))))
 117          (advice-add #'context-coloring-colorize :around advice)
 118          (setq colorization-start-time (float-time))
 119          (find-file fixture)))
 120      fixtures)))
 121
 122 (defconst context-coloring-benchmark-javascript-fixtures
 123   '("./fixtures/benchmark/jquery-2.1.1.js"
 124     "./fixtures/benchmark/lodash-2.4.1.js"
 125     "./fixtures/benchmark/async-0.9.0.js"
 126     "./fixtures/benchmark/mkdirp-0.5.0.js")
 127   "Arbitrary JavaScript files for performance scrutiny.")
 128
 129 (defun context-coloring-benchmark-js2-mode-run ()
 130   "Benchmark `js2-mode'."
 131   (add-to-list 'auto-mode-alist '("\\.js\\'" . js2-mode))
 132   (add-hook 'js2-mode-hook #'context-coloring-mode)
 133   (let ((js2-mode-show-parse-errors nil)
 134         (js2-mode-show-strict-warnings nil))
 135     (context-coloring-benchmark
 136      "js2-mode"
 137      context-coloring-benchmark-javascript-fixtures))
 138   (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
 139                                 auto-mode-alist))
 140   (remove-hook 'js2-mode-hook #'context-coloring-mode))
 141
 142 (defconst context-coloring-benchmark-emacs-lisp-fixtures
 143   '("./fixtures/benchmark/lisp.el"
 144     "./fixtures/benchmark/faces.el"
 145     "./fixtures/benchmark/subr.el"
 146     "./fixtures/benchmark/simple.el")
 147   "Arbitrary Emacs Lisp files for performance scrutiny.")
 148
 149 (defun context-coloring-benchmark-emacs-lisp-mode-run ()
 150   "Benchmark `emacs-lisp-mode', then call CALLBACK."
 151   (add-hook 'emacs-lisp-mode-hook #'context-coloring-mode)
 152   (context-coloring-benchmark
 153    "emacs-lisp-mode"
 154    context-coloring-benchmark-emacs-lisp-fixtures)
 155   (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
 156
 157 (defun context-coloring-benchmark-run ()
 158   "Benchmark all modes, then exit."
 159   (context-coloring-benchmark-js2-mode-run)
 160   (context-coloring-benchmark-emacs-lisp-mode-run)
 161   (kill-emacs))
 162
 163 (provide 'context-coloring-benchmark)
 164
 165 ;;; context-coloring-benchmark.el ends here