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-log-results (result-file fixture statistics)
  42   "Log results to RESULT-FILE for FIXTURE with STATISTICS."
  43   (let ((results (prog1
  44                      (progn
  45                        (elp-results)
  46                        (buffer-substring-no-properties (point-min) (point-max)))
  47                    (kill-buffer))))
  48     (make-directory (context-coloring-benchmark-resolve-path "./logs") t)
  49     (append-to-file
  50      (with-temp-buffer
  51        (goto-char (point-min))
  52        (insert (format "For fixture \"%s\":\n" fixture))
  53        (insert "\n")
  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)))
  65        (insert "\n")
  66        (insert "Function statistics:\n")
  67        (insert "(Function Name / Call Count / Elapsed Time / Average Time):\n")
  68        (insert results)
  69        (insert "\n")
  70        (buffer-substring-no-properties (point-min) (point-max)))
  71      nil result-file)))
  72
  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")))))
  78     (mapc
  79      (lambda (path)
  80        (let ((fixture (context-coloring-benchmark-resolve-path path))
  81              colorization-start-time
  82              (colorization-times '())
  83              advice)
  84          (setq
  85           advice
  86           (let ((count 0))
  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.
  92               (when (<= count 5)
  93                 (push (- (float-time) colorization-start-time) colorization-times))
  94               (cond
  95                ((= count 10)
  96                 (advice-remove #'context-coloring-colorize advice)
  97                 (context-coloring-benchmark-log-results
  98                  result-file
  99                  fixture
 100                  (list
 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)))
 106                 (elp-restore-all)
 107                 (kill-buffer))
 108                ;; The last 5 runs are for gathering function call and
 109                ;; duration statistics.
 110                ((= count 5)
 111                 (elp-instrument-package "context-coloring-")
 112                 (context-coloring-colorize))
 113                (t
 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)))
 119      fixtures)))
 120
 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.")
 127
 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
 135      "js2-mode"
 136      context-coloring-benchmark-javascript-fixtures))
 137   (setq auto-mode-alist (delete '("\\.js\\'" . js2-mode)
 138                                 auto-mode-alist))
 139   (remove-hook 'js2-mode-hook #'context-coloring-mode))
 140
 141 (defconst context-coloring-benchmark-emacs-lisp-fixtures
 142   '("./fixtures/lisp.el"
 143     "./fixtures/faces.el"
 144     "./fixtures/subr.el"
 145     "./fixtures/simple.el")
 146   "Arbitrary Emacs Lisp files for performance scrutiny.")
 147
 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
 152    "emacs-lisp-mode"
 153    context-coloring-benchmark-emacs-lisp-fixtures)
 154   (remove-hook 'emacs-lisp-mode-hook #'context-coloring-mode))
 155
 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)
 160   (kill-emacs))
 161
 162 (provide 'context-coloring-benchmark)
 163
 164 ;;; context-coloring-benchmark.el ends here