下面代码可能非常长，我也不知道可以怎么优化，关键是 profiler 的结果比较平均，想问问有没有大神看哪段写法比较难受的，可以指出问题。
最近有点想重写 parinfer， 不过感觉依然不知道怎么得到比较好的性能。
下面是一个完成度不怎么高的代码，我通常打开一个 lisp 的 buffer 然后用 parinfer-bench 或 parinfer-report 来测试性能。
对于一个600行的 clojure 代码(其它 lisp 应该也一样)，一次处理要 180ms，byte compile 之后 20ms。这个性能还是有点惨，想优化但是没有什么头绪，求指导。
;;; -*- lexical-binding: t -*-
(require 'cl-lib)
(require 'dash)
;;; Errors
(defconst pi/error-eol-backslash
"Line cannot end in a hanging character escaping.")
(defconst pi/error-quote-danger
"Quotes must balanced inside comment blocks.")
(defconst pi/error-unclosed-quote
"String is missing a closing quote.")
(defconst pi/error-unclosed-paren
"Unclosed open-paren.")
(defconst pi/error-unmatched-close-paren
"Unmatched close-paren.")
(defconst pi/error-leading-close-paren
"Line cannot lead with a close-paren.")
;;; Faces
(defface parinfer-trail-face
'((t (:foreground "grey40")))
"Face for dimming trails."
:group 'parinfer)
(defface parinfer-error-face
'((t (:underline (:style wave :color "red"))))
"Face for parsing error."
:group 'parinfer)
(defvar pi/mode 'indent
"Can be indent, paren or smart.")
(defvar pi/cursor-line-no nil
"Line number of cursor.")
(defvar pi/cursor-line-x nil
"Line x of cursor.")
(defvar pi/protect-range nil
"The range of content that won't be changed.")
(defvar pi/current-indent 0
"Current indentation.")
(defvar pi/changes nil
"The changes to made.")
(defvar pi/line-x 0
"Current line x.")
(defvar pi/line-no 0
"Current line number.")
(defvar pi/quote-danger nil
"If we are quote danger.")
(defvar pi/error nil
"A list of errors.
Has structure of (error . (beg . end)) ")
(defvar pi/openers nil
"A stack of openers, we will push element in when we meet an opener.
Each element has a structure of (type . point)")
(defvar pi/closers nil
"A stack of closers, we will push element in when we meet a closer,
Each element has a structure of (type . point)")
(defvar pi/current-trail nil
"Current tail, has structure of (beg . end)")
(defvar pi/trails nil
"A list of trails where we can insert or remove parens.
The trail should start with a closer, contains zero or more whitespace and closers, till the end of line. But contains no code characters.
Each element has a structure of (beg . end).
When we apply modifications to buffer, all whitespace in the trails will be deleted.
All closers in the trail will be apply a dim face.")
(defvar pi/indents nil
"A list of indent to make.
Each element has a structure of (line-number . shift-x)")
(defvar pi/parse-state nil
"Current state when parsing, can be one of: nil, 'string, 'comment, 'escape.")
(make-variable-buffer-local
(defvar pi/escape-char nil))
(setq-default pi/escape-char 92)
;;; Debug
(defvar pi/debug t)
(setq pi/debug nil)
(defvar pi/log-buffer-name "*parinfer-log*")
;;; Processing
(defun pi/delete (pos)
(push (cons nil pos) pi/changes))
(defun pi/insert (ch pos)
(push (cons ch pos) pi/changes))
(defun pi/get-closer-ch (opener-type)
(cl-case opener-type
((round) ")")
((square) "]")
((curly) "}")))
(defun pi/init-current-trail (pos)
"Init current trail at POS."
(setq pi/current-trail (cons pos pos)))
(defun pi/extend-current-trail ()
"Extend current trail by one point."
(setq pi/current-trail
(cons (car pi/current-trail)
(1+ (cdr pi/current-trail)))))
(defun pi/delete-trail-whitespaces (from to)
"Delete whitespaces in trail."
(-let (((beg . end) pi/protect-range))
(pi/log "protect range" (list :from from :protect pi/protect-range))
(while (< from to)
(unless (and (<= beg from)
(< from end))
(pi/delete from))
(setq from (1+ from)))))
(defun pi/handle-indent-end ()
(pi/log "handle indent end" (list :current-trail pi/current-trail
:closers pi/closers
:openers pi/openers))
(when pi/current-trail
(-let (((trail-beg . trail-end) pi/current-trail)
(closers))
;; Pop trail closers from variable `pi/closers',
;; put them into variable `closers' for later usage.
(while (let ((pos (cadar pi/closers)))
(and pos (>= pos trail-beg)))
(push (pop pi/closers) closers))
(pi/log "the closers in trail" closers)
;; Closing openers
(-let ((break)
;; We use this cnt variable to iterate chars in trails.
;; If there's no closer with pos equals (+ trail-beg cnt)
;; means there is a whitespace.
;; We remove these whitespace, except when cursor is after it in the same line.
(cnt 0))
(while (not break)
(-let* ((opener (car pi/openers))
((opener-type opener-pos opener-indent) opener))
(if (or (not opener)
(< opener-indent pi/current-indent))
(setq break t)
(pi/log "adjust trail for opener" opener)
(pop pi/openers)
(-let* ((closer (pop closers))
((closer-type closer-pos closer-indent) closer))
;; remove whitespaces
(when closer
(pi/delete-trail-whitespaces (+ trail-beg cnt) closer-pos)
(setq cnt (- closer-pos trail-beg)))
;; match closer
(cond
((not closer)
(let ((ch (pi/get-closer-ch opener-type)))
(pi/log "no closer found, insert" (cons ch (cons cnt trail-beg)))
(pi/insert ch (+ cnt trail-beg))))
((eq closer-type opener-type)
(setq cnt (1+ cnt))
(pi/log "closer is correct" nil))
(t
(let ((ch (pi/get-closer-ch opener-type)))
(pi/log "incorrect closer, change it to " ch)
(setq cnt (1+ cnt))
(pi/insert ch closer-pos)
(pi/delete closer-pos))))))))
;; Remove extra closers
(dolist (closer closers)
(-let (((_ closer-pos _) closer))
(pi/delete-trail-whitespaces (+ trail-beg cnt) closer-pos)
(pi/delete closer-pos)
(setq cnt (1+ cnt)))))
;; Add this trail to variable `pi/trails'
;; (push pi/current-trail pi/trails)
))
(setq pi/current-indent nil
pi/current-trail nil))
(defun pi/close-current-trail (pos)
"When we start a new trail at POS to replace the current one."
(when pi/closers
(pi/log "replace trail" (list :pos pos :closers pi/closers :openers pi/openers))
(dolist (closer (nreverse pi/closers))
(if (not pi/openers)
(progn
(pi/log "extra closer, remove it." pos)
(pi/delete (cadr closer)))
(-let* (((closer-type closer-pos closer-indent) closer)
(opener (pop pi/openers))
((opener-type opener-pos opener-indent) opener))
(if (eq closer-type opener-type)
(pi/log "match paren" (list :opener opener :closer closer))
(pi/log "! unmatched close paren"
(list :opener opener :closer closer))
(setq pi/error (cons pi/error-unmatched-close-paren
(cons opener-pos (1+ closer-pos))))))))
(setq pi/closers nil)))
(defun pi/handle-trail-end (indent)
"End current trail with current trail."
())
(defun pi/process-opener (type pos)
"Process a opener with `type' at `pos'.
Update openers.
Init current trail at pos. "
(if pi/current-indent
(pi/handle-indent-end)
(pi/close-current-trail pos)
(setq pi/current-trail (cons pos pos)))
(let ((opener `(,type ,(1- pos) ,pi/line-x)))
(pi/log "opener" opener)
(push opener pi/openers)
(pi/init-current-trail pos)
;; (pi/log "openers stack" pi/openers)
))
(defun pi/process-closer (type pos)
"Process a closer with `type' at `pos'.
Update openers.
Extend current trail at pos. "
(let ((closer `(,type ,(1- pos) ,pi/line-x)))
(pi/log "closer" closer)
(if pi/current-indent
(setq pi/error (cons pi/error-leading-close-paren
(cons (line-beginning-position) pos)))
(push closer pi/closers)
(pi/extend-current-trail))))
(defun pi/process-newline (pos)
"Process a newline at `pos'.
Increament pi/line-no by 1.
Set pi/current-indent to 0. "
(pi/log "newline" pos)
(setq pi/line-no (1+ pi/line-no)
pi/line-x -1
pi/current-indent 0))
(defun pi/process-whitespace (pos)
"Process a whitespace at `pos'.
When at indent,
Increment pi/current-indent by 1.
When not,
Extend pi/current-trail."
(cond
(pi/current-indent (setq pi/current-indent (1+ pi/current-indent)))
(t
(pi/log "extend trail" pos)
(pi/extend-current-trail))))
(defun pi/process-delimiter (pos)
(pi/process-code 34 pos)
(setq pi/parse-state 'string)
(if pi/current-indent
(pi/handle-indent-end)
(pi/close-current-trail pos)))
(defun pi/process-commenter (pos)
(setq pi/current-indent nil)
(setq pi/parse-state 'comment))
(defun pi/process-code (ch pos)
"Process code at `pos'.
Init current trail at pos."
(pi/log "code" (cons (concat "\"" (char-to-string ch) "\"") pos))
(if pi/current-indent
(pi/handle-indent-end)
(pi/close-current-trail pos)
(setq pi/current-trail (cons pos pos)))
(setq pi/current-indent nil)
(pi/init-current-trail pos))
(defun pi/process-after-escape (ch pos)
(if (= ch 10)
(setq pi/error (cons pi/error-eol-backslash (cons (1- pos) pos)))
(pi/log "escaped char" ch)
(setq pi/parse-state nil)
(pi/process-code ch pos)))
(defun pi/process-escape (pos)
(pi/log "escape enable" pos)
(setq pi/parse-state 'escape)
(pi/process-code ch pos))
(defun pi/process-in-string (ch pos)
(if (not (= ch 34))
(pi/log "in string" pos)
(pi/log "end string" pos)
(setq pi/parse-state nil)
(pi/init-current-trail pos)))
(defun pi/process-in-comment (ch pos)
(cond
((= ch 10)
(if pi/quote-danger
(setq pi/error (cons pi/error-quote-danger (cons pi/quote-danger pos)))
(pi/log "end comment" pos)
(pi/process-newline pos)
(setq pi/parse-state nil)))
((= ch 34)
(if pi/quote-danger
(setq pi/quote-danger nil)
(setq pi/quote-danger pos))
(pi/log "toggle quote danger" pos))
(t
(pi/log "in comment" pos))))
(defun pi/process-eof ()
(cond
((eq pi/parse-state 'escape)
(setq pi/error (cons pi/error-eol-backslash
(cons (1- (point-max)) (point-max)))))
((eq pi/parse-state 'string)
(setq pi/error (cons pi/error-unclosed-quote
(cons (1- (point-max)) (point-max)))))
(t
(setq pi/line-x 0
pi/line-no (1+ pi/line-no)
pi/current-indent 0)
(pi/handle-indent-end))))
(defun pi/parse-1 (ch pos)
"Parse on a single pos."
(setq pi/line-x (1+ pi/line-x))
(cond
((eq pi/parse-state 'escape)
(pi/process-after-escape))
((= ch pi/escape-char)
(pi/process-escape pos))
((eq pi/parse-state 'string)
(pi/process-in-string ch pos))
((eq pi/parse-state 'comment)
(pi/process-in-comment ch pos))
(t
(case ch
(32 (pi/process-whitespace pos))
(10 (pi/process-newline pos))
(40 (pi/process-opener 'round pos))
(41 (pi/process-closer 'round pos))
(91 (pi/process-opener 'square pos))
(93 (pi/process-closer 'square pos))
(123 (pi/process-opener 'curly pos))
(125 (pi/process-closer 'curly pos))
(34 (pi/process-delimiter pos))
(59 (pi/process-commenter pos))
(t (pi/process-code ch pos))))))
(defun pi/get-protect-range ()
"Return the protect range.
It begins at line beggining, and ends at cursor position."
(cons (line-beginning-position)
(point)))
(defun pi/reset-state ()
"Reset all parser state."
(setq pi/cursor-line-no (line-number-at-pos (point) t)
pi/cursor-line-x (- (point) (line-beginning-position))
pi/protect-range (pi/get-protect-range)
pi/parse-state nil
pi/quote-danger nil
pi/openers nil
pi/closers nil
pi/trails nil
pi/indents nil
pi/line-no 0
pi/line-x -1
pi/error nil
pi/current-indent 0
pi/current-trail nil
pi/changes nil))
(defun pi/parse ()
(pi/reset-state)
(let ((max (point-max))
(pos (point-min)))
(while (and (not pi/error)
(not (= pos max)))
(setq pos (1+ pos))
(pi/parse-1 (char-before pos) pos)))
;; We already at the end of buffer.
;; Deal with unhandled trails.
(pi/log "eof parse" nil)
(pi/process-eof))
;;; Apply changes
(defun pi/apply-changes ()
(save-mark-and-excursion
(let ((inhibit-x-resources)))
(dolist (change pi/changes)
(-let (((ch . pos) change))
(goto-char pos)
(if (not ch)
(progn
(delete-char 1))
(insert-char ch))))))
;;; Highlight
(defun pi/mark-error ()
(remove-overlays (point-min) (point-max) 'name 'parinfer-error)
(when pi/error
(-let* (((error-message . (beg . end)) pi/error)
(ov (make-overlay beg end)))
(overlay-put ov 'face 'parinfer-error-face)
(overlay-put ov 'name 'parinfer-error)
(message error-message))))
(defun pi/mark-trails ()
"Mark trails for current buffer."
(remove-overlays (point-min) (point-max) 'name 'parinfer-trail)
(dolist (p pi/trails)
(when p
(-let* (((beg . _) p)
(ov (make-overlay beg (save-mark-and-excursion
(goto-char beg)
(line-end-position)))))
(overlay-put ov 'face 'parinfer-trail-face)
(overlay-put ov 'name 'parinfer-trail)))))
(defun pi/log-1 (pre msg)
(with-current-buffer (get-buffer-create pi/log-buffer-name)
(insert (format "[ NO:%5d X:%5d IDT:%5s] %s -> %s\n" pi/line-no pi/line-x pi/current-indent pre msg))))
(defun pi/log-state-1 ()
(pi/log "-------------" nil)
(pi/log "Openers" pi/openers)
(pi/log "Closers" pi/closers)
(pi/log "Trails" pi/trails)
(pi/log "Changes" pi/changes)
(pi/log "Error" pi/error)
(when (window-live-p (get-buffer-window pi/log-buffer-name))
(with-selected-window (get-buffer-window pi/log-buffer-name)
(goto-char (point-max)))))
(defun pi/log-clr ()
(with-current-buffer (get-buffer-create pi/log-buffer-name)
(delete-region (point-min) (point-max))
(text-mode)))
(defmacro pi/log (pre msg)
(if pi/debug
`(pi/log-1 ,pre ,msg)
nil))
(defun pi/process-buffer ()
(interactive)
(pi/log-clr)
(pi/parse)
(unless pi/error
(pi/apply-changes))
(pi/mark-error)
(pi/log-state))
(global-set-key (kbd "C-z") #'pi/process-buffer)
(defun pi/process ()
(interactive)
(pi/parse)
(unless pi/error
(pi/apply-changes))
(pi/mark-error))
(defun pi/enable ()
(add-hook 'post-command-hook 'pi/process nil t))
(defun pi/disable ()
(remove-hook 'post-command-hook 'pi/process t))
(defmacro parinfer--measure-time (&rest body)
"Measure the time it takes to evaluate BODY."
`(let ((time (current-time)))
,@body
(message "%.06fms" (* (float-time (time-since time)) 1000))))
(defun parinfer-bench ()
(interactive)
(parinfer--measure-time
(pi/process)))
(defun parinfer-report ()
(interactive)
(profiler-start 'cpu)
(parinfer--measure-time
(dotimes (_ 10)
(pi/process)))
(profiler-report)
(profiler-stop))
(define-minor-mode parinfer-mode
"Simpler Lisp Edit."
nil
nil
nil
(if parinfer-mode
(pi/enable)
(pi/disable)))
(provide 'parinfer)
非常感谢！