;;; tree-sitter-benchmark.el -*- lexical-binding: t; -*-
;; run benchmark with
;; emacs -Q --script tree-sitter-benchmark.el [-1] [-2] [-3] [-regexp]

(require 'treesit)
(require 'cc-mode)

(defvar query-type 'list
  "How to save the query. Either `string' or `list'.")
(defcustom fontifying-mode 'treesit
  "Benchmark mode."
  :type '(choice (const treesit)
                 (const regexp)))
(setq fontifying-mode 'regexp)


(defvar c-font-lock-settings-1
  `((c
     ,(with-temp-buffer
        (insert-file-contents-literally "./highlights.scm")
        ;; make capture names map to a face, any face
        (goto-char (point-min))
        (while (re-search-forward "@[a-z.]+" nil t)
          (replace-match "@font-lock-string-face" t))
        (pcase query-type
          ('string
           (buffer-substring (point-min) (point-max)))
          ('list
           (goto-char (point-min))
           (insert "(")
           (goto-char (point-max))
           (insert ")")
           (goto-char (point-min))
           (read (current-buffer)))
          (_ (user-error "`query-type' must be 'string or 'list")))))))

(defun setup-fontification ()
  (pcase fontifying-mode
    ('treesit
     (treesit-get-parser-create 'c)
     ;; This needs to be non-nil, because reasons
     (unless font-lock-defaults
       (setq font-lock-defaults '(nil t)))
     (setq-local treesit-font-lock-defaults
                 '((c-font-lock-settings-1)))
     (treesit-font-lock-enable)
     (advice-add #'font-lock-default-fontify-region :override #'ignore))
    ('regexp
     (c-mode))))

(defun fontify (beg end)
  (pcase fontifying-mode
    ('treesit (font-lock-fontify-region beg end))
    ('regexp (font-lock-fontify-region beg end nil))))

(defun buffer-middle ()
  (/ (+ (point-min) (point-max)) 2))

(with-temp-buffer
  (message "Fontification method: %s %s" fontifying-mode query-type)
  (setup-fontification)
  (insert-file-contents "xdisp.c")
  (apply #'message
         "Benchmark 1: fontify xdisp.c all at once.\
 took %2.3f, with %d gc runs (meaning %2.3f)"
         (benchmark-run 1
           (fontify (point-min) (point-max))))

  (set-text-properties (point-min) (point-max) nil)

  ;; fontify xdisp.c from the middle, since it starts with a comment header of
  ;; 22k chars
  (goto-char (buffer-middle))
  (apply #'message
         "Benchmark 2: fontify part of xdisp.c, 20 batches of 512 chars.\
 took %2.3f, with %d gc runs (meaning %2.3f)"
         (benchmark-run 1
           (dotimes (_ 20)
             (fontify (point) (min (+ 512 (point)) (point-max)))
             (forward-char 512))))

  (kill-new (buffer-substring (buffer-middle) (+ (* 512 10) (buffer-middle))))

  (set-text-properties (point-min) (point-max) nil)

  (goto-char (point-min))
  (apply #'message
         "Benchmark 3: fontify all of xdisp.c, 512 chars at a time.\
 took %2.3f, with %d gc runs (meaning %2.3f)"
         (benchmark-run 1
           (while (/= (point-max) (point))
             (fontify (point) (min (+ 512 (point)) (point-max)))
             (goto-char (min (+ 512 (point)) (point-max))))))



  (advice-remove #'font-lock-default-fontify-region #'ignore))